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

[stylesheets] *reindent/delete-trailing-whitespace/untabify*

Browse Source
This commit is contained in:
Christopher Lam
2019-04-09 06:57:45 +08:00
parent 375013f9ea
commit 1338162d14
6 changed files with 676 additions and 675 deletions
Download Patch File Download Diff File Expand all files Collapse all files

244
gnucash/report/stylesheets/stylesheet-easy.scm
View File

@@ -4,23 +4,23 @@
;; ;;
;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.com> ;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.com>
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of ;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version. ;; the License, or (at your option) any later version.
;; ;;
;; This program is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
;; Free Software Foundation Voice: +1-617-542-5942 ;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org ;; Boston, MA 02110-1301, USA gnu@gnu.org
;; ;;
;; Based on work from: ;; Based on work from:
;; stylesheet-header.scm ;; stylesheet-header.scm
;; Copyright 2000 Bill Gribble <grib@gnumatic.com> ;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
@@ -29,7 +29,7 @@
(define-module (gnucash report stylesheet-easy)) (define-module (gnucash report stylesheet-easy))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@@ -38,34 +38,34 @@
(define (easy-options) (define (easy-options)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
(opt-register (opt-register
(lambda (opt) (lambda (opt)
(gnc:register-option options opt)))) (gnc:register-option options opt))))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Preparer") "a" (N_ "Preparer") "a"
(N_ "Name of person preparing the report.") (N_ "Name of person preparing the report.")
"")) ""))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Prepared for") "b" (N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.") (N_ "Name of organization or company prepared for.")
"")) ""))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Show preparer info") "c" (N_ "Show preparer info") "c"
(N_ "Name of organization or company.") (N_ "Name of organization or company.")
#f)) #f))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Enable Links") "d" (N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.") (N_ "Enable hyperlinks in reports.")
#t)) #t))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
(N_ "Images") (N_ "Images")
@@ -82,14 +82,14 @@
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.") (N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left 'left
(list (vector 'left (list (vector 'left
(N_ "Left") (N_ "Left")
(N_ "Align the banner to the left.")) (N_ "Align the banner to the left."))
(vector 'center (vector 'center
(N_ "Center") (N_ "Center")
(N_ "Align the banner in the center.")) (N_ "Align the banner in the center."))
(vector 'right (vector 'right
(N_ "Right") (N_ "Right")
(N_ "Align the banner to the right.")) (N_ "Align the banner to the right."))
))) )))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
@@ -102,14 +102,14 @@
(N_ "Colors") (N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.") (N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.") (N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 #xff) (list #x00 #x00 #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -123,7 +123,7 @@
(N_ "Colors") (N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -157,20 +157,20 @@
(list #xff #xff #x00 #xff) (list #xff #xff #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells.") (N_ "Table cell spacing") "a" (N_ "Space between table cells.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.") (N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1)) 1 0 20 0 1))
@@ -180,47 +180,47 @@
(define (easy-renderer options doc) (define (easy-renderer options doc)
(let* ((ssdoc (gnc:make-html-document)) (let* ((ssdoc (gnc:make-html-document))
(opt-val (opt-val
(lambda (section name) (lambda (section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(color-val (color-val
(lambda (section name) (lambda (section name)
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(preparer (opt-val (N_ "General") (N_ "Preparer"))) (preparer (opt-val (N_ "General") (N_ "Preparer")))
(prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) (prepared-for (opt-val (N_ "General") (N_ "Prepared for")))
(show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info")))
(links? (opt-val (N_ "General") (N_ "Enable Links"))) (links? (opt-val (N_ "General") (N_ "Enable Links")))
(bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) (bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color"))) (textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) (linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors") (alternate-row-color (color-val (N_ "Colors")
(N_ "Alternate Table Cell Color"))) (N_ "Alternate Table Cell Color")))
(primary-subheading-color (primary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Subheading/Subtotal Cell Color"))) (N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color (secondary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color"))) (N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors") (grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color"))) (N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (logopixmap (opt-val (N_ "Images") (N_ "Logo")))
(align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment"))))
(spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing")))
(padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) (padding (opt-val (N_ "Tables") (N_ "Table cell padding")))
(border (opt-val (N_ "Tables") (N_ "Table border width"))) (border (opt-val (N_ "Tables") (N_ "Table border width")))
(headcolumn 0)) (headcolumn 0))
; center the document without elements inheriting anything ; center the document without elements inheriting anything
(gnc:html-document-add-object! ssdoc (gnc:html-document-add-object! ssdoc
(gnc:make-html-text "<center>")) (gnc:make-html-text "<center>"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "bgcolor" bgcolor) 'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor) 'attribute (list "text" textcolor)
'attribute (list "link" linkcolor)) 'attribute (list "link" linkcolor))
@@ -293,13 +293,13 @@
'attribute (list "class" "centered-label-cell")) 'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap (if (and bgpixmap
(not (string=? bgpixmap ""))) (not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap)))) 'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "table" ssdoc "table"
'attribute (list "border" border) 'attribute (list "border" border)
'attribute (list "cellspacing" spacing) 'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding)) 'attribute (list "cellpadding" padding))
@@ -311,38 +311,38 @@
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "alternate-row" ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color) 'attribute (list "bgcolor" alternate-row-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "primary-subheading" ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color) 'attribute (list "bgcolor" primary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "secondary-subheading" ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color) 'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "grand-total" ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color) 'attribute (list "bgcolor" grand-total-color)
'tag "tr") 'tag "tr")
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "a" 'tag "")) ssdoc "a" 'tag ""))
(let ((t (gnc:make-html-table))) (let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want ;; we don't want a bevel for this table, but we don't want
;; that to propagate ;; that to propagate
(gnc:html-table-set-style! (gnc:html-table-set-style!
t "table" t "table"
'attribute (list "border" 0) 'attribute (list "border" 0)
'inheritable? #f) 'inheritable? #f)
; set the header column to be the 2nd when we have a logo ; set the header column to be the 2nd when we have a logo
; do this so that when logo is not present, the document ; do this so that when logo is not present, the document
; is perfectly centered ; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1)) (set! headcolumn 1))
(add-css-information-to-doc options ssdoc doc) (add-css-information-to-doc options ssdoc doc)
@@ -350,10 +350,10 @@
(doc-headline (gnc:html-document-headline doc)) (doc-headline (gnc:html-document-headline doc))
(headline (if (eq? doc-headline #f) title doc-headline))) (headline (if (eq? doc-headline #f) title doc-headline)))
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 1 headcolumn t 1 headcolumn
(if show-preparer? (if show-preparer?
;; title plus preparer info ;; title plus preparer info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline) (gnc:html-markup-h3 headline)
(gnc:html-markup-br) (gnc:html-markup-br)
@@ -367,42 +367,42 @@
(qof-print-date (qof-print-date
(current-time))) (current-time)))
;; title only ;; title only
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline)))) (gnc:html-markup-h3 headline))))
) )
; only setup an image if we specified one ; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(begin (begin
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 0 t 0 0
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))) (gnc:html-markup-img (make-file-url logopixmap))))))
(if (and headpixmap (> (string-length headpixmap) 0)) (if (and headpixmap (> (string-length headpixmap) 0))
(begin (begin
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text
(string-append
"<div align=\"" align "\">"
"<img src=\"" (make-file-url headpixmap) "\">"
"</div>")))
)
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 headcolumn t 0 headcolumn
(gnc:make-html-text (gnc:make-html-text "&nbsp;")))
(string-append
"<div align=\"" align "\">" (apply
"<img src=\"" (make-file-url headpixmap) "\">" gnc:html-table-set-cell!
"</div>")))
)
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text "&nbsp;")))
(apply
gnc:html-table-set-cell!
t 2 headcolumn t 2 headcolumn
(gnc:html-document-objects doc)) (gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t)) (gnc:html-document-add-object! ssdoc t))
(gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated) (gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated)
ssdoc)) ssdoc))
(gnc:define-html-style-sheet (gnc:define-html-style-sheet
'version 1 'version 1
'name (N_ "Easy") 'name (N_ "Easy")
'renderer easy-renderer 'renderer easy-renderer

248
gnucash/report/stylesheets/stylesheet-fancy.scm
View File

@@ -1,17 +1,17 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stylesheet-header.scm : stylesheet with nicer layout ;; stylesheet-header.scm : stylesheet with nicer layout
;; Copyright 2000 Bill Gribble <grib@gnumatic.com> ;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of ;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version. ;; the License, or (at your option) any later version.
;; ;;
;; This program is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
@@ -23,7 +23,7 @@
(define-module (gnucash report stylesheet-fancy)) (define-module (gnucash report stylesheet-fancy))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@@ -32,34 +32,34 @@
(define (fancy-options) (define (fancy-options)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
(opt-register (opt-register
(lambda (opt) (lambda (opt)
(gnc:register-option options opt)))) (gnc:register-option options opt))))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Preparer") "a" (N_ "Preparer") "a"
(N_ "Name of person preparing the report.") (N_ "Name of person preparing the report.")
"")) ""))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Prepared for") "b" (N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.") (N_ "Name of organization or company prepared for.")
"")) ""))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Show preparer info") "c" (N_ "Show preparer info") "c"
(N_ "Name of organization or company.") (N_ "Name of organization or company.")
#f)) #f))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Enable Links") "d" (N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.") (N_ "Enable hyperlinks in reports.")
#t)) #t))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
(N_ "Images") (N_ "Images")
@@ -76,14 +76,14 @@
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.") (N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left 'left
(list (vector 'left (list (vector 'left
(N_ "Left") (N_ "Left")
(N_ "Align the banner to the left.")) (N_ "Align the banner to the left."))
(vector 'center (vector 'center
(N_ "Center") (N_ "Center")
(N_ "Align the banner in the center.")) (N_ "Align the banner in the center."))
(vector 'right (vector 'right
(N_ "Right") (N_ "Right")
(N_ "Align the banner to the right.")) (N_ "Align the banner to the right."))
))) )))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
@@ -96,14 +96,14 @@
(N_ "Colors") (N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.") (N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.") (N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 #xff) (list #x00 #x00 #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -117,7 +117,7 @@
(N_ "Colors") (N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -151,20 +151,20 @@
(list #xff #xff #x00 #xff) (list #xff #xff #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells.") (N_ "Table cell spacing") "a" (N_ "Space between table cells.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.") (N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1)) 1 0 20 0 1))
@@ -174,47 +174,47 @@
(define (fancy-renderer options doc) (define (fancy-renderer options doc)
(let* ((ssdoc (gnc:make-html-document)) (let* ((ssdoc (gnc:make-html-document))
(opt-val (opt-val
(lambda (section name) (lambda (section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(color-val (color-val
(lambda (section name) (lambda (section name)
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(preparer (opt-val (N_ "General") (N_ "Preparer"))) (preparer (opt-val (N_ "General") (N_ "Preparer")))
(prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) (prepared-for (opt-val (N_ "General") (N_ "Prepared for")))
(show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info")))
(links? (opt-val (N_ "General") (N_ "Enable Links"))) (links? (opt-val (N_ "General") (N_ "Enable Links")))
(bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) (bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color"))) (textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) (linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors") (alternate-row-color (color-val (N_ "Colors")
(N_ "Alternate Table Cell Color"))) (N_ "Alternate Table Cell Color")))
(primary-subheading-color (primary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Subheading/Subtotal Cell Color"))) (N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color (secondary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color"))) (N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors") (grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color"))) (N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (logopixmap (opt-val (N_ "Images") (N_ "Logo")))
(align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment"))))
(spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing")))
(padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) (padding (opt-val (N_ "Tables") (N_ "Table cell padding")))
(border (opt-val (N_ "Tables") (N_ "Table border width"))) (border (opt-val (N_ "Tables") (N_ "Table border width")))
(headcolumn 0)) (headcolumn 0))
; center the document without elements inheriting anything ; center the document without elements inheriting anything
(gnc:html-document-add-object! ssdoc (gnc:html-document-add-object! ssdoc
(gnc:make-html-text "<center>")) (gnc:make-html-text "<center>"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "bgcolor" bgcolor) 'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor) 'attribute (list "text" textcolor)
'attribute (list "link" linkcolor)) 'attribute (list "link" linkcolor))
@@ -288,13 +288,13 @@
'attribute (list "class" "centered-label-cell")) 'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap (if (and bgpixmap
(not (string=? bgpixmap ""))) (not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap)))) 'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "table" ssdoc "table"
'attribute (list "border" border) 'attribute (list "border" border)
'attribute (list "cellspacing" spacing) 'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding)) 'attribute (list "cellpadding" padding))
@@ -306,32 +306,32 @@
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "alternate-row" ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color) 'attribute (list "bgcolor" alternate-row-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "primary-subheading" ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color) 'attribute (list "bgcolor" primary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "secondary-subheading" ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color) 'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "grand-total" ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color) 'attribute (list "bgcolor" grand-total-color)
'tag "tr") 'tag "tr")
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "a" 'tag "")) ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc) (add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table))) (let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want ;; we don't want a bevel for this table, but we don't want
;; that to propagate ;; that to propagate
(gnc:html-table-set-style! (gnc:html-table-set-style!
t "table" t "table"
'attribute (list "border" 0) 'attribute (list "border" 0)
'inheritable? #f) 'inheritable? #f)
@@ -339,18 +339,18 @@
(doc-headline (gnc:html-document-headline doc)) (doc-headline (gnc:html-document-headline doc))
(headline (if (eq? doc-headline #f) title doc-headline))) (headline (if (eq? doc-headline #f) title doc-headline)))
; set the header column to be the 2nd when we have a logo ; set the header column to be the 2nd when we have a logo
; do this so that when logo is not present, the document ; do this so that when logo is not present, the document
; is perfectly centered ; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1)) (set! headcolumn 1))
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 1 headcolumn t 1 headcolumn
(if show-preparer? (if show-preparer?
;; title plus preparer info ;; title plus preparer info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline) (gnc:html-markup-h3 headline)
(gnc:html-markup-br) (gnc:html-markup-br)
(_ "Prepared by: ") (_ "Prepared by: ")
(gnc:html-markup-b preparer) (gnc:html-markup-b preparer)
@@ -362,48 +362,48 @@
(qof-print-date (qof-print-date
(current-time))) (current-time)))
;; title only ;; title only
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline)))) (gnc:html-markup-h3 headline))))
) )
(if (and logopixmap (if (and logopixmap
(not (string=? logopixmap ""))) (not (string=? logopixmap "")))
;; check for logo image file name non blank ;; check for logo image file name non blank
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 0 t 0 0
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))) ) (gnc:html-markup-img (make-file-url logopixmap)))) )
(if (and headpixmap (if (and headpixmap
(not (string=? headpixmap ""))) (not (string=? headpixmap "")))
;; check for header image file name nonblank ;; check for header image file name nonblank
(begin (begin
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 headcolumn t 0 headcolumn
(gnc:make-html-text (gnc:make-html-text
;; XX: isn't there some way to apply the alignment to ;; XX: isn't there some way to apply the alignment to
;; (gnc:html-markup-img headpixmap)? ;; (gnc:html-markup-img headpixmap)?
(string-append (string-append
"<div align=\"" align "\">" "<div align=\"" align "\">"
"<img src=\"" (make-file-url headpixmap) "\">" "<img src=\"" (make-file-url headpixmap) "\">"
"</div>"))) "</div>")))
) )
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 headcolumn t 0 headcolumn
(gnc:make-html-text "&nbsp;"))) (gnc:make-html-text "&nbsp;")))
(apply (apply
gnc:html-table-set-cell! gnc:html-table-set-cell!
t 2 headcolumn t 2 headcolumn
(gnc:html-document-objects doc)) (gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t)) (gnc:html-document-add-object! ssdoc t))
(gnc:html-document-add-object! ssdoc (gnc:html-document-add-object! ssdoc
(gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated) (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated)
ssdoc)) ssdoc))
(gnc:define-html-style-sheet (gnc:define-html-style-sheet
'version 1.01 'version 1.01
'name (N_ "Fancy") 'name (N_ "Fancy")
'renderer fancy-renderer 'renderer fancy-renderer

251
gnucash/report/stylesheets/stylesheet-footer.scm
View File

@@ -4,23 +4,23 @@
;; ;;
;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.com> ;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.com>
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of ;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version. ;; the License, or (at your option) any later version.
;; ;;
;; This program is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
;; Free Software Foundation Voice: +1-617-542-5942 ;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org ;; Boston, MA 02110-1301, USA gnu@gnu.org
;; ;;
;; Based on work from: ;; Based on work from:
;; stylesheet-header.scm ;; stylesheet-header.scm
;; Copyright 2000 Bill Gribble <grib@gnumatic.com> ;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
@@ -34,7 +34,7 @@
(define-module (gnucash report stylesheet-footer)) (define-module (gnucash report stylesheet-footer))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@@ -43,34 +43,34 @@
(define (footer-options) (define (footer-options)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
(opt-register (opt-register
(lambda (opt) (lambda (opt)
(gnc:register-option options opt)))) (gnc:register-option options opt))))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Preparer") "a" (N_ "Preparer") "a"
(N_ "Name of person preparing the report.") (N_ "Name of person preparing the report.")
"")) ""))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
(N_ "Prepared for") "b" (N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.") (N_ "Name of organization or company prepared for.")
"")) ""))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Show preparer info") "c" (N_ "Show preparer info") "c"
(N_ "Name of organization or company.") (N_ "Name of organization or company.")
#f)) #f))
(opt-register (opt-register
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "General") (N_ "General")
(N_ "Enable Links") "d" (N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.") (N_ "Enable hyperlinks in reports.")
#t)) #t))
; FIXME: put this in a more sensible tab like Text or Header/Footer ;; FIXME: put this in a more sensible tab like Text or Header/Footer
(opt-register (opt-register
(gnc:make-text-option (gnc:make-text-option
(N_ "General") (N_ "General")
@@ -95,14 +95,14 @@
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.") (N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left 'left
(list (vector 'left (list (vector 'left
(N_ "Left") (N_ "Left")
(N_ "Align the banner to the left.")) (N_ "Align the banner to the left."))
(vector 'center (vector 'center
(N_ "Center") (N_ "Center")
(N_ "Align the banner in the center.")) (N_ "Align the banner in the center."))
(vector 'right (vector 'right
(N_ "Right") (N_ "Right")
(N_ "Align the banner to the right.")) (N_ "Align the banner to the right."))
))) )))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
@@ -115,14 +115,14 @@
(N_ "Colors") (N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.") (N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.") (N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 #xff) (list #x00 #x00 #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -136,7 +136,7 @@
(N_ "Colors") (N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff) (list #xff #xff #xff #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
@@ -170,20 +170,20 @@
(list #xff #xff #x00 #xff) (list #xff #xff #x00 #xff)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells.") (N_ "Table cell spacing") "a" (N_ "Space between table cells.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
1 0 20 0 1)) 1 0 20 0 1))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.") (N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1)) 1 0 20 0 1))
@@ -193,48 +193,48 @@
(define (footer-renderer options doc) (define (footer-renderer options doc)
(let* ((ssdoc (gnc:make-html-document)) (let* ((ssdoc (gnc:make-html-document))
(opt-val (opt-val
(lambda (section name) (lambda (section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(color-val (color-val
(lambda (section name) (lambda (section name)
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(preparer (opt-val (N_ "General") (N_ "Preparer"))) (preparer (opt-val (N_ "General") (N_ "Preparer")))
(prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) (prepared-for (opt-val (N_ "General") (N_ "Prepared for")))
(show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info")))
(links? (opt-val (N_ "General") (N_ "Enable Links"))) (links? (opt-val (N_ "General") (N_ "Enable Links")))
(footer-text (opt-val (N_ "General") (N_ "Footer"))) (footer-text (opt-val (N_ "General") (N_ "Footer")))
(bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) (bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color"))) (textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) (linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors") (alternate-row-color (color-val (N_ "Colors")
(N_ "Alternate Table Cell Color"))) (N_ "Alternate Table Cell Color")))
(primary-subheading-color (primary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Subheading/Subtotal Cell Color"))) (N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color (secondary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color"))) (N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors") (grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color"))) (N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (logopixmap (opt-val (N_ "Images") (N_ "Logo")))
(align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment"))))
(spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing")))
(padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) (padding (opt-val (N_ "Tables") (N_ "Table cell padding")))
(border (opt-val (N_ "Tables") (N_ "Table border width"))) (border (opt-val (N_ "Tables") (N_ "Table border width")))
(headcolumn 0)) (headcolumn 0))
; center the document without elements inheriting anything ;; center the document without elements inheriting anything
(gnc:html-document-add-object! ssdoc (gnc:html-document-add-object! ssdoc
(gnc:make-html-text "<center>")) (gnc:make-html-text "<center>"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "bgcolor" bgcolor) 'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor) 'attribute (list "text" textcolor)
'attribute (list "link" linkcolor)) 'attribute (list "link" linkcolor))
@@ -307,13 +307,13 @@
'attribute (list "class" "centered-label-cell")) 'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap (if (and bgpixmap
(not (string=? bgpixmap ""))) (not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap)))) 'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "table" ssdoc "table"
'attribute (list "border" border) 'attribute (list "border" border)
'attribute (list "cellspacing" spacing) 'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding)) 'attribute (list "cellpadding" padding))
@@ -325,48 +325,48 @@
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "alternate-row" ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color) 'attribute (list "bgcolor" alternate-row-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "primary-subheading" ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color) 'attribute (list "bgcolor" primary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "secondary-subheading" ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color) 'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "grand-total" ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color) 'attribute (list "bgcolor" grand-total-color)
'tag "tr") 'tag "tr")
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! ssdoc "a" 'tag "")) (gnc:html-document-set-style! ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc) (add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table))) (let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want ;; we don't want a bevel for this table, but we don't want
;; that to propagate ;; that to propagate
(gnc:html-table-set-style! (gnc:html-table-set-style!
t "table" t "table"
'attribute (list "border" 0) 'attribute (list "border" 0)
'inheritable? #f) 'inheritable? #f)
; set the header column to be the 2nd when we have a logo ;; set the header column to be the 2nd when we have a logo
; do this so that when logo is not present, the document ;; do this so that when logo is not present, the document
; is perfectly centered ;; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1)) (set! headcolumn 1))
(let* ((title (gnc:html-document-title doc)) (let* ((title (gnc:html-document-title doc))
(doc-headline (gnc:html-document-headline doc)) (doc-headline (gnc:html-document-headline doc))
(headline (if (eq? doc-headline #f) title doc-headline))) (headline (if (eq? doc-headline #f) title doc-headline)))
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 1 headcolumn t 1 headcolumn
(if show-preparer? (if show-preparer?
;; title plus preparer info ;; title plus preparer info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline) (gnc:html-markup-h3 headline)
(gnc:html-markup-br) (gnc:html-markup-br)
@@ -380,47 +380,48 @@
(qof-print-date (qof-print-date
(current-time))) (current-time)))
;; title only ;; title only
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline)))) (gnc:html-markup-h3 headline))))
) )
; only setup an image if we specified one ;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(begin (begin
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 0 t 0 0
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))) (gnc:html-markup-img (make-file-url logopixmap))))))
(if (and headpixmap (> (string-length headpixmap) 0)) (if (and headpixmap (> (string-length headpixmap) 0))
(begin (begin
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text
(string-append
"<div align=\"" align "\">"
"<img src=\"" (make-file-url headpixmap) "\">"
"</div>")))
)
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 headcolumn t 0 headcolumn
(gnc:make-html-text (gnc:make-html-text "&nbsp;")))
(string-append
"<div align=\"" align "\">" (apply
"<img src=\"" (make-file-url headpixmap) "\">" gnc:html-table-set-cell!
"</div>")))
)
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text "&nbsp;")))
(apply
gnc:html-table-set-cell!
t 2 headcolumn t 2 headcolumn
(gnc:html-document-objects doc)) (gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t) (gnc:html-document-add-object! ssdoc t)
; I think this is the correct place to put the footer ;; I think this is the correct place to put the footer
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 3 headcolumn t 3 headcolumn
(gnc:make-html-text footer-text))) (gnc:make-html-text footer-text)))
(gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated) (gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>"))
;;TODO: make this a div instead of <center> (deprecated)
ssdoc)) ssdoc))
(gnc:define-html-style-sheet (gnc:define-html-style-sheet
'version 1 'version 1
'name (N_ "Footer") 'name (N_ "Footer")
'renderer footer-renderer 'renderer footer-renderer

430
gnucash/report/stylesheets/stylesheet-head-or-tail.scm
View File

@@ -35,7 +35,7 @@
(define-module (gnucash report stylesheet-head-or-tail)) (define-module (gnucash report stylesheet-head-or-tail))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash core-utils)) ; for gnc:version (use-modules (gnucash core-utils)) ; for gnc:version
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@@ -45,9 +45,9 @@
(define (head-or-tail-options) (define (head-or-tail-options)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
(opt-register (opt-register
(lambda (opt) (lambda (opt)
(gnc:register-option options opt)))) (gnc:register-option options opt))))
(opt-register (opt-register
(gnc:make-string-option (gnc:make-string-option
(N_ "General") (N_ "General")
@@ -96,7 +96,7 @@
(N_ "Enable Links") "h" (N_ "Enable Links") "h"
(N_ "Enable hyperlinks in reports.") (N_ "Enable hyperlinks in reports.")
#t)) #t))
; FIXME: put this in a more sensible tab like Text or Header/Footer ;; FIXME: put this in a more sensible tab like Text or Header/Footer
(opt-register (opt-register
(gnc:make-text-option (gnc:make-text-option
(N_ "General") (N_ "General")
@@ -151,14 +151,14 @@
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.") (N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left 'left
(list (vector 'left (list (vector 'left
(N_ "Left") (N_ "Left")
(N_ "Align the banner to the left.")) (N_ "Align the banner to the left."))
(vector 'center (vector 'center
(N_ "Center") (N_ "Center")
(N_ "Align the banner in the center.")) (N_ "Align the banner in the center."))
(vector 'right (vector 'right
(N_ "Right") (N_ "Right")
(N_ "Align the banner to the right.")) (N_ "Align the banner to the right."))
))) )))
(opt-register (opt-register
(gnc:make-pixmap-option (gnc:make-pixmap-option
@@ -249,54 +249,54 @@
(define (head-or-tail-renderer options doc) (define (head-or-tail-renderer options doc)
(let* ((ssdoc (gnc:make-html-document)) (let* ((ssdoc (gnc:make-html-document))
(opt-val (opt-val
(lambda (section name) (lambda (section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(color-val (color-val
(lambda (section name) (lambda (section name)
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(preparer (opt-val (N_ "General") (N_ "Preparer"))) (preparer (opt-val (N_ "General") (N_ "Preparer")))
(prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) (prepared-for (opt-val (N_ "General") (N_ "Prepared for")))
(show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info")))
(show-receiver? (opt-val (N_ "General") (N_ "Show receiver info"))) (show-receiver? (opt-val (N_ "General") (N_ "Show receiver info")))
(show-date? (opt-val (N_ "General") (N_ "Show date"))) (show-date? (opt-val (N_ "General") (N_ "Show date")))
(show-time? (opt-val (N_ "General") (N_ "Show time in addition to date"))) (show-time? (opt-val (N_ "General") (N_ "Show time in addition to date")))
(show-gnucash-version? (opt-val (N_ "General") (N_ "Show GnuCash Version"))) (show-gnucash-version? (opt-val (N_ "General") (N_ "Show GnuCash Version")))
(show-preparer-at-bottom? (opt-val (N_ "General") (N_ "Show preparer info at bottom"))) (show-preparer-at-bottom? (opt-val (N_ "General") (N_ "Show preparer info at bottom")))
(show-receiver-at-bottom? (opt-val (N_ "General") (N_ "Show receiver info at bottom"))) (show-receiver-at-bottom? (opt-val (N_ "General") (N_ "Show receiver info at bottom")))
(show-date-time-at-bottom? (opt-val (N_ "General") (N_ "Show date/time at bottom"))) (show-date-time-at-bottom? (opt-val (N_ "General") (N_ "Show date/time at bottom")))
(show-comments-at-bottom? (opt-val (N_ "General") (N_ "Show comments at bottom"))) (show-comments-at-bottom? (opt-val (N_ "General") (N_ "Show comments at bottom")))
(show-gnucash-version-at-bottom? (opt-val (N_ "General") (N_ "Show GnuCash version at bottom"))) (show-gnucash-version-at-bottom? (opt-val (N_ "General") (N_ "Show GnuCash version at bottom")))
(links? (opt-val (N_ "General") (N_ "Enable Links"))) (links? (opt-val (N_ "General") (N_ "Enable Links")))
(additional-comments (opt-val (N_ "General") (N_ "Additional Comments"))) (additional-comments (opt-val (N_ "General") (N_ "Additional Comments")))
(bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) (bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color"))) (textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) (linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors") (alternate-row-color (color-val (N_ "Colors")
(N_ "Alternate Table Cell Color"))) (N_ "Alternate Table Cell Color")))
(primary-subheading-color (primary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Subheading/Subtotal Cell Color"))) (N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color (secondary-subheading-color
(color-val (N_ "Colors") (color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color"))) (N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors") (grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color"))) (N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (logopixmap (opt-val (N_ "Images") (N_ "Logo")))
(align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment"))))
(spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing")))
(padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) (padding (opt-val (N_ "Tables") (N_ "Table cell padding")))
(border (opt-val (N_ "Tables") (N_ "Table border width"))) (border (opt-val (N_ "Tables") (N_ "Table border width")))
(headcolumn 0)) (headcolumn 0))
; center the document without elements inheriting anything ;; center the document without elements inheriting anything
(gnc:html-document-add-object! ssdoc (gnc:html-document-add-object! ssdoc
(gnc:make-html-text "<center>")) (gnc:make-html-text "<center>"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
@@ -372,10 +372,10 @@
'attribute (list "class" "centered-label-cell")) 'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap (if (and bgpixmap
(not (string=? bgpixmap ""))) (not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap)))) 'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "table" ssdoc "table"
@@ -406,7 +406,7 @@
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! ssdoc "a" 'tag "")) (gnc:html-document-set-style! ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc) (add-css-information-to-doc options ssdoc doc)
@@ -418,122 +418,122 @@
'attribute (list "border" 0) 'attribute (list "border" 0)
'inheritable? #f) 'inheritable? #f)
; set the header column to be the 2nd when we have a logo ;; set the header column to be the 2nd when we have a logo
; do this so that when logo is not present, the document ;; do this so that when logo is not present, the document
; is perfectly centered ;; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1)) (set! headcolumn 1))
(let* ((title (gnc:html-document-title doc)) (let* ((title (gnc:html-document-title doc))
(doc-headline (gnc:html-document-headline doc)) (doc-headline (gnc:html-document-headline doc))
(headline (if (eq? doc-headline #f) title doc-headline))) (headline (if (eq? doc-headline #f) title doc-headline)))
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 1 headcolumn t 1 headcolumn
;; print title ;; print title
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline)) (gnc:html-markup-h3 headline))
(if (and show-preparer? (not show-preparer-at-bottom?)) (if (and show-preparer? (not show-preparer-at-bottom?))
;; print preparer info as additional header info ;; print preparer info as additional header info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
(_ "Prepared by: ") (_ "Prepared by: ")
(gnc:html-markup-b preparer) (gnc:html-markup-b preparer)
) )
(gnc:html-markup-br) (gnc:html-markup-br)
) )
" " " "
) )
(if (and show-receiver? (not show-receiver-at-bottom?)) (if (and show-receiver? (not show-receiver-at-bottom?))
;; print receiver info as additional header info ;; print receiver info as additional header info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
(_ "Prepared for: ") (_ "Prepared for: ")
(gnc:html-markup-b prepared-for) (gnc:html-markup-b prepared-for)
(gnc:html-markup-br) (gnc:html-markup-br)
)
) )
) " "
" " )
) (if (and show-date? (not show-date-time-at-bottom?))
(if (and show-date? (not show-date-time-at-bottom?)) ;; print date/time info as additional header info
;; print date/time info as additional header info (if show-time?
(if show-time? (gnc:make-html-text
(gnc:make-html-text (gnc:html-markup-i
(gnc:html-markup-i (_ "Report Creation Date: ")
(_ "Report Creation Date: ") (qof-print-date (gnc:get-today))
(qof-print-date (gnc:get-today)) " "
" " (strftime "%X %Z" (localtime (current-time)))
(strftime "%X %Z" (localtime (current-time))) )
) (gnc:html-markup-br)
(gnc:html-markup-br) )
) (gnc:make-html-text
(gnc:make-html-text (gnc:html-markup-i
(gnc:html-markup-i (_ "Report Creation Date: ")
(_ "Report Creation Date: ") (qof-print-date (gnc:get-today))
(qof-print-date (gnc:get-today)) )
) (gnc:html-markup-br)
(gnc:html-markup-br) )
) )
) " "
" " )
) (if (and show-gnucash-version? (not show-gnucash-version-at-bottom?))
(if (and show-gnucash-version? (not show-gnucash-version-at-bottom?)) ;; print the GnuCash version string as additional header info
;; print the GnuCash version string as additional header info (gnc:make-html-text
(gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
"GnuCash " "GnuCash "
gnc:version gnc:version
) )
(gnc:html-markup-br) (gnc:html-markup-br)
) )
" " " "
) )
(if (not show-comments-at-bottom?) (if (not show-comments-at-bottom?)
;; print additional comments as additional header info ;; print additional comments as additional header info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-br) (gnc:html-markup-br)
(gnc:html-markup-i additional-comments) (gnc:html-markup-i additional-comments)
(gnc:html-markup-br) (gnc:html-markup-br)
)
" "
)
;; add separator line if any additional header info is printed
(if (or
(and show-preparer? (not show-preparer-at-bottom?))
(and show-receiver? (not show-receiver-at-bottom?))
(and show-date? (not show-date-time-at-bottom?))
(and show-gnucash-version? (not show-gnucash-version-at-bottom?))
(not show-comments-at-bottom?)
) )
(gnc:make-html-text " "
)
;; add separator line if any additional header info is printed
(if (or
(and show-preparer? (not show-preparer-at-bottom?))
(and show-receiver? (not show-receiver-at-bottom?))
(and show-date? (not show-date-time-at-bottom?))
(and show-gnucash-version? (not show-gnucash-version-at-bottom?))
(not show-comments-at-bottom?)
)
(gnc:make-html-text
(gnc:html-markup-br) (gnc:html-markup-br)
) )
" " " "
) )
)
) )
)
; only setup an image if we specified one ;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0)) (if (and logopixmap (> (string-length logopixmap) 0))
(begin (begin
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 0 t 0 0
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))) (gnc:html-markup-img (make-file-url logopixmap))))))
(if (and headpixmap (> (string-length headpixmap) 0)) (if (and headpixmap (> (string-length headpixmap) 0))
(begin (begin
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text
(string-append
"<div align=\"" align "\">"
"<img src=\"" (make-file-url headpixmap) "\">"
"</div>")))
)
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 0 headcolumn t 0 headcolumn
(gnc:make-html-text (gnc:make-html-text "&nbsp;")))
(string-append
"<div align=\"" align "\">"
"<img src=\"" (make-file-url headpixmap) "\">"
"</div>")))
)
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text "&nbsp;")))
(apply (apply
gnc:html-table-set-cell! gnc:html-table-set-cell!
@@ -541,88 +541,88 @@
(gnc:html-document-objects doc)) (gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t) (gnc:html-document-add-object! ssdoc t)
; I think this is the correct place to put the footer ;; I think this is the correct place to put the footer
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
t 3 headcolumn t 3 headcolumn
;;(gnc:make-html-text additional-comments) ;;(gnc:make-html-text additional-comments)
;; add separator line if any additional header info is printed ;; add separator line if any additional header info is printed
(if (or (if (or
(and show-preparer? show-preparer-at-bottom?) (and show-preparer? show-preparer-at-bottom?)
(and show-receiver? show-receiver-at-bottom?) (and show-receiver? show-receiver-at-bottom?)
(and show-date? show-date-time-at-bottom?) (and show-date? show-date-time-at-bottom?)
(and show-gnucash-version? show-gnucash-version-at-bottom?) (and show-gnucash-version? show-gnucash-version-at-bottom?)
show-comments-at-bottom? show-comments-at-bottom?
) )
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-br) (gnc:html-markup-br)
) )
" " " "
) )
(if (and show-preparer? show-preparer-at-bottom?) (if (and show-preparer? show-preparer-at-bottom?)
;; print preparer info as additional header info ;; print preparer info as additional header info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
(_ "Prepared by: ") (_ "Prepared by: ")
(gnc:html-markup-b preparer) (gnc:html-markup-b preparer)
) )
(gnc:html-markup-br) (gnc:html-markup-br)
) )
" " " "
) )
(if (and show-receiver? show-receiver-at-bottom?) (if (and show-receiver? show-receiver-at-bottom?)
;; print receiver info as additional header info ;; print receiver info as additional header info
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
(_ "Prepared for: ") (_ "Prepared for: ")
(gnc:html-markup-b prepared-for) (gnc:html-markup-b prepared-for)
) )
(gnc:html-markup-br) (gnc:html-markup-br)
)
" "
)
(if (and show-date? show-date-time-at-bottom?)
;; print date/time info as additional header info
(if show-time?
(gnc:make-html-text
(gnc:html-markup-i
(_ "Report Creation Date: ")
(qof-print-date (gnc:get-today))
" "
(strftime "%X %Z" (localtime (current-time)))
)
(gnc:html-markup-br)
) )
(gnc:make-html-text " "
(gnc:html-markup-i )
(_ "Report Creation Date: ") (if (and show-date? show-date-time-at-bottom?)
(qof-print-date (gnc:get-today)) ;; print date/time info as additional header info
(if show-time?
(gnc:make-html-text
(gnc:html-markup-i
(_ "Report Creation Date: ")
(qof-print-date (gnc:get-today))
" "
(strftime "%X %Z" (localtime (current-time)))
)
(gnc:html-markup-br) (gnc:html-markup-br)
) )
) (gnc:make-html-text
) (gnc:html-markup-i
" " (_ "Report Creation Date: ")
) (qof-print-date (gnc:get-today))
(if (and show-gnucash-version? show-gnucash-version-at-bottom?) (gnc:html-markup-br)
;; print the GnuCash version string as additional header info )
(gnc:make-html-text )
)
" "
)
(if (and show-gnucash-version? show-gnucash-version-at-bottom?)
;; print the GnuCash version string as additional header info
(gnc:make-html-text
(gnc:html-markup-i (gnc:html-markup-i
(_ "GnuCash ") (_ "GnuCash ")
gnc:version gnc:version
)
(gnc:html-markup-br)
) )
" "
)
(if show-comments-at-bottom?
;; print additional comments as additional header info
(gnc:make-html-text
(gnc:html-markup-br) (gnc:html-markup-br)
) (gnc:html-markup-i additional-comments)
" "
)
(if show-comments-at-bottom?
;; print additional comments as additional header info
(gnc:make-html-text
(gnc:html-markup-br) (gnc:html-markup-br)
(gnc:html-markup-i additional-comments) )
(gnc:html-markup-br) " "
) )
" " ))
)
))
(gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated) (gnc:html-document-add-object! ssdoc (gnc:make-html-text "</center>")) ;;TODO: make this a div instead of <center> (deprecated)
ssdoc)) ssdoc))

174
gnucash/report/stylesheets/stylesheet-plain.scm
View File

@@ -24,7 +24,7 @@
(define-module (gnucash report stylesheet-plain)) (define-module (gnucash report stylesheet-plain))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash core-utils)) (use-modules (gnucash core-utils))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@@ -39,89 +39,89 @@
;; it's supposed to be lightweight and unobtrusive. ;; it's supposed to be lightweight and unobtrusive.
(define (plain-options) (define (plain-options)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
(opt-register
(lambda (opt)
(gnc:register-option options opt))))
(opt-register
(gnc:make-color-option
(N_ "General")
(N_ "Background Color") "a" (N_ "Background color for reports.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register (opt-register
(gnc:make-pixmap-option (lambda (opt)
(N_ "General") (gnc:register-option options opt))))
(N_ "Background Pixmap") "b" (N_ "Background tile for reports.") (opt-register
"")) (gnc:make-color-option
(opt-register (N_ "General")
(gnc:make-simple-boolean-option (N_ "Background Color") "a" (N_ "Background color for reports.")
(N_ "General") (list #xff #xff #xff #xff)
(N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.") 255 #f))
#t)) (opt-register
(opt-register (gnc:make-pixmap-option
(gnc:make-color-option (N_ "General")
(N_ "Colors") (N_ "Background Pixmap") "b" (N_ "Background tile for reports.")
(N_ "Alternate Table Cell Color") "a" (N_ "Background color for alternate lines.") ""))
(list #xff #xff #xff #xff) (opt-register
255 #f)) (gnc:make-simple-boolean-option
(opt-register (N_ "General")
(gnc:make-number-range-option (N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.")
(N_ "Tables") #t))
(N_ "Table cell spacing") "a" (N_ "Space between table cells.") (opt-register
0 0 20 0 1)) (gnc:make-color-option
(opt-register (N_ "Colors")
(gnc:make-number-range-option (N_ "Alternate Table Cell Color") "a" (N_ "Background color for alternate lines.")
(N_ "Tables") (list #xff #xff #xff #xff)
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") 255 #f))
4 0 20 0 1)) (opt-register
(opt-register (gnc:make-number-range-option
(gnc:make-number-range-option (N_ "Tables")
(N_ "Tables") (N_ "Table cell spacing") "a" (N_ "Space between table cells.")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.") 0 0 20 0 1))
0 0 20 0 1)) (opt-register
(register-font-options options) (gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
4 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.")
0 0 20 0 1))
(register-font-options options)
options)) options))
(define (plain-renderer options doc) (define (plain-renderer options doc)
(let* (let*
((ssdoc (gnc:make-html-document)) ((ssdoc (gnc:make-html-document))
(opt-val (opt-val
(lambda (section name) (lambda (section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name)))) (gnc:lookup-option options section name))))
(bgcolor (bgcolor
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options (gnc:lookup-option options
"General" "General"
"Background Color"))) "Background Color")))
(bgpixmap (opt-val "General" "Background Pixmap")) (bgpixmap (opt-val "General" "Background Pixmap"))
(links? (opt-val "General" "Enable Links")) (links? (opt-val "General" "Enable Links"))
(alternate-row-color (alternate-row-color
(gnc:color-option->html (gnc:color-option->html
(gnc:lookup-option options (gnc:lookup-option options
"Colors" "Colors"
"Alternate Table Cell Color"))) "Alternate Table Cell Color")))
(spacing (opt-val "Tables" "Table cell spacing")) (spacing (opt-val "Tables" "Table cell spacing"))
(padding (opt-val "Tables" "Table cell padding")) (padding (opt-val "Tables" "Table cell padding"))
(border (opt-val "Tables" "Table border width")) (border (opt-val "Tables" "Table border width"))
) )
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "bgcolor" bgcolor))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "body" ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap)))) 'attribute (list "bgcolor" bgcolor))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "table" ssdoc "table"
'attribute (list "border" border) 'attribute (list "border" border)
'attribute (list "cellspacing" spacing) 'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding)) 'attribute (list "cellpadding" padding))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "column-heading-left" ssdoc "column-heading-left"
@@ -189,13 +189,13 @@
'attribute (list "class" "centered-label-cell")) 'attribute (list "class" "centered-label-cell"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "normal-row" ssdoc "normal-row"
'tag "tr") 'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "alternate-row" ssdoc "alternate-row"
'tag "tr" 'tag "tr"
'attribute (list "bgcolor" alternate-row-color)) 'attribute (list "bgcolor" alternate-row-color))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "primary-subheading" ssdoc "primary-subheading"
@@ -212,9 +212,9 @@
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "a" ssdoc "a"
'tag "")) 'tag ""))
(add-css-information-to-doc options ssdoc doc) (add-css-information-to-doc options ssdoc doc)
@@ -223,13 +223,13 @@
(headline (if (eq? doc-headline #f) (headline (if (eq? doc-headline #f)
title doc-headline))) title doc-headline)))
(if headline (if headline
(gnc:html-document-add-object! (gnc:html-document-add-object!
ssdoc ssdoc
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 headline))))) (gnc:html-markup-h3 headline)))))
(gnc:html-document-append-objects! ssdoc (gnc:html-document-append-objects! ssdoc
(gnc:html-document-objects doc)) (gnc:html-document-objects doc))
ssdoc)) ssdoc))

4
gnucash/report/stylesheets/stylesheets.scm
View File

@@ -2,7 +2,7 @@
;; stylesheets.scm ;; stylesheets.scm
;; load the standard stylesheet definitions ;; load the standard stylesheet definitions
;; ;;
;; Copyright (c) 2001 Linux Developers Group, Inc. ;; Copyright (c) 2001 Linux Developers Group, Inc.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
@@ -26,7 +26,7 @@
(define-module (gnucash report stylesheets)) (define-module (gnucash report stylesheets))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (gnucash report stylesheet-plain)) (use-modules (gnucash report stylesheet-plain))
(use-modules (gnucash report stylesheet-fancy)) (use-modules (gnucash report stylesheet-fancy))
(use-modules (gnucash report stylesheet-footer)) (use-modules (gnucash report stylesheet-footer))