diff --git a/gnucash/report/stylesheets/stylesheet-easy.scm b/gnucash/report/stylesheets/stylesheet-easy.scm index 3f5cff55d8..b1eed52f5e 100644 --- a/gnucash/report/stylesheets/stylesheet-easy.scm +++ b/gnucash/report/stylesheets/stylesheet-easy.scm @@ -4,23 +4,23 @@ ;; ;; Copyright 2004 James Strandboge ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; ;; Free Software Foundation Voice: +1-617-542-5942 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; Boston, MA 02110-1301, USA gnu@gnu.org -;; +;; ;; Based on work from: ;; stylesheet-header.scm ;; Copyright 2000 Bill Gribble @@ -29,7 +29,7 @@ (define-module (gnucash report stylesheet-easy)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -38,34 +38,34 @@ (define (easy-options) (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - (opt-register + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + (opt-register (gnc:make-string-option (N_ "General") (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 (N_ "General") (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 (N_ "General") (N_ "Show preparer info") "c" - (N_ "Name of organization or company.") + (N_ "Name of organization or company.") #f)) - (opt-register + (opt-register (gnc:make-simple-boolean-option (N_ "General") (N_ "Enable Links") "d" - (N_ "Enable hyperlinks in reports.") + (N_ "Enable hyperlinks in reports.") #t)) - + (opt-register (gnc:make-pixmap-option (N_ "Images") @@ -82,14 +82,14 @@ (N_ "Heading Alignment") "c" (N_ "Banner for top of report.") 'left (list (vector 'left - (N_ "Left") - (N_ "Align the banner to the left.")) + (N_ "Left") + (N_ "Align the banner to the left.")) (vector 'center - (N_ "Center") - (N_ "Align the banner in the center.")) + (N_ "Center") + (N_ "Align the banner in the center.")) (vector 'right - (N_ "Right") - (N_ "Align the banner to the right.")) + (N_ "Right") + (N_ "Align the banner to the right.")) ))) (opt-register (gnc:make-pixmap-option @@ -102,14 +102,14 @@ (N_ "Colors") (N_ "Background Color") "a" (N_ "General background color for report.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option (N_ "Colors") (N_ "Text Color") "b" (N_ "Normal body text color.") (list #x00 #x00 #x00 #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -123,7 +123,7 @@ (N_ "Colors") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -157,20 +157,20 @@ (list #xff #xff #x00 #xff) 255 #f)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell spacing") "a" (N_ "Space between table cells.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table border width") "c" (N_ "Bevel depth on tables.") 1 0 20 0 1)) @@ -180,47 +180,47 @@ (define (easy-renderer options doc) (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (color-val - (lambda (section name) - (gnc:color-option->html - (gnc:lookup-option options section name)))) - (preparer (opt-val (N_ "General") (N_ "Preparer"))) - (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) - (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) - (links? (opt-val (N_ "General") (N_ "Enable Links"))) - (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) - (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) - (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) - (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) - (alternate-row-color (color-val (N_ "Colors") - (N_ "Alternate Table Cell Color"))) - (primary-subheading-color - (color-val (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color"))) - (secondary-subheading-color - (color-val (N_ "Colors") - (N_ "Sub-subheading/total Cell Color"))) - (grand-total-color (color-val (N_ "Colors") - (N_ "Grand Total Cell Color"))) - (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) - (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) - (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (color-val + (lambda (section name) + (gnc:color-option->html + (gnc:lookup-option options section name)))) + (preparer (opt-val (N_ "General") (N_ "Preparer"))) + (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) + (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) + (links? (opt-val (N_ "General") (N_ "Enable Links"))) + (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) + (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) + (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) + (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) + (alternate-row-color (color-val (N_ "Colors") + (N_ "Alternate Table Cell Color"))) + (primary-subheading-color + (color-val (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color"))) + (secondary-subheading-color + (color-val (N_ "Colors") + (N_ "Sub-subheading/total Cell Color"))) + (grand-total-color (color-val (N_ "Colors") + (N_ "Grand Total Cell Color"))) + (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) + (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) + (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) - (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) - (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) - (border (opt-val (N_ "Tables") (N_ "Table border width"))) + (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) + (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) + (border (opt-val (N_ "Tables") (N_ "Table border width"))) (headcolumn 0)) - ; center the document without elements inheriting anything + ; center the document without elements inheriting anything (gnc:html-document-add-object! ssdoc - (gnc:make-html-text "
")) + (gnc:make-html-text "
")) - (gnc:html-document-set-style! - ssdoc "body" + (gnc:html-document-set-style! + ssdoc "body" 'attribute (list "bgcolor" bgcolor) 'attribute (list "text" textcolor) 'attribute (list "link" linkcolor)) @@ -293,13 +293,13 @@ 'attribute (list "class" "centered-label-cell")) (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" (make-file-url bgpixmap)))) - + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" (make-file-url bgpixmap)))) + (gnc:html-document-set-style! - ssdoc "table" + ssdoc "table" 'attribute (list "border" border) 'attribute (list "cellspacing" spacing) 'attribute (list "cellpadding" padding)) @@ -311,38 +311,38 @@ (gnc:html-document-set-style! ssdoc "alternate-row" 'attribute (list "bgcolor" alternate-row-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "primary-subheading" 'attribute (list "bgcolor" primary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "secondary-subheading" 'attribute (list "bgcolor" secondary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "grand-total" 'attribute (list "bgcolor" grand-total-color) - 'tag "tr") + 'tag "tr") ;; don't surround marked-up links with (if (not links?) - (gnc:html-document-set-style! - ssdoc "a" 'tag "")) - + (gnc:html-document-set-style! + ssdoc "a" 'tag "")) + (let ((t (gnc:make-html-table))) - ;; we don't want a bevel for this table, but we don't want - ;; that to propagate + ;; we don't want a bevel for this table, but we don't want + ;; that to propagate (gnc:html-table-set-style! - t "table" + t "table" 'attribute (list "border" 0) 'inheritable? #f) - ; set the header column to be the 2nd when we have a logo - ; do this so that when logo is not present, the document - ; is perfectly centered + ; set the header column to be the 2nd when we have a logo + ; do this so that when logo is not present, the document + ; is perfectly centered (if (and logopixmap (> (string-length logopixmap) 0)) - (set! headcolumn 1)) + (set! headcolumn 1)) (add-css-information-to-doc options ssdoc doc) @@ -350,10 +350,10 @@ (doc-headline (gnc:html-document-headline doc)) (headline (if (eq? doc-headline #f) title doc-headline))) - (gnc:html-table-set-cell! + (gnc:html-table-set-cell! t 1 headcolumn - (if show-preparer? - ;; title plus preparer info + (if show-preparer? + ;; title plus preparer info (gnc:make-html-text (gnc:html-markup-h3 headline) (gnc:html-markup-br) @@ -367,42 +367,42 @@ (qof-print-date (current-time))) - ;; title only + ;; title only (gnc:make-html-text (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)) - (begin - (gnc:html-table-set-cell! - t 0 0 - (gnc:make-html-text - (gnc:html-markup-img (make-file-url logopixmap)))))) - + (begin + (gnc:html-table-set-cell! + t 0 0 + (gnc:make-html-text + (gnc:html-markup-img (make-file-url logopixmap)))))) + (if (and headpixmap (> (string-length headpixmap) 0)) - (begin + (begin + (gnc:html-table-set-cell! + t 0 headcolumn + (gnc:make-html-text + (string-append + "
" + "" + "
"))) + ) (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text - (string-append - "
" - "" - "
"))) - ) - (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text " "))) - - (apply - gnc:html-table-set-cell! + t 0 headcolumn + (gnc:make-html-text " "))) + + (apply + gnc:html-table-set-cell! t 2 headcolumn (gnc:html-document-objects doc)) (gnc:html-document-add-object! ssdoc t)) (gnc:html-document-add-object! ssdoc (gnc:make-html-text "
")) ;;TODO: make this a div instead of
(deprecated) ssdoc)) -(gnc:define-html-style-sheet +(gnc:define-html-style-sheet 'version 1 'name (N_ "Easy") 'renderer easy-renderer diff --git a/gnucash/report/stylesheets/stylesheet-fancy.scm b/gnucash/report/stylesheets/stylesheet-fancy.scm index 46f2bc124b..26dae6e551 100644 --- a/gnucash/report/stylesheets/stylesheet-fancy.scm +++ b/gnucash/report/stylesheets/stylesheet-fancy.scm @@ -1,17 +1,17 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; stylesheet-header.scm : stylesheet with nicer layout ;; Copyright 2000 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -23,7 +23,7 @@ (define-module (gnucash report stylesheet-fancy)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -32,34 +32,34 @@ (define (fancy-options) (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - (opt-register + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + (opt-register (gnc:make-string-option (N_ "General") (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 (N_ "General") (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 (N_ "General") (N_ "Show preparer info") "c" - (N_ "Name of organization or company.") + (N_ "Name of organization or company.") #f)) - (opt-register + (opt-register (gnc:make-simple-boolean-option (N_ "General") (N_ "Enable Links") "d" - (N_ "Enable hyperlinks in reports.") + (N_ "Enable hyperlinks in reports.") #t)) - + (opt-register (gnc:make-pixmap-option (N_ "Images") @@ -76,14 +76,14 @@ (N_ "Heading Alignment") "c" (N_ "Banner for top of report.") 'left (list (vector 'left - (N_ "Left") - (N_ "Align the banner to the left.")) + (N_ "Left") + (N_ "Align the banner to the left.")) (vector 'center - (N_ "Center") - (N_ "Align the banner in the center.")) + (N_ "Center") + (N_ "Align the banner in the center.")) (vector 'right - (N_ "Right") - (N_ "Align the banner to the right.")) + (N_ "Right") + (N_ "Align the banner to the right.")) ))) (opt-register (gnc:make-pixmap-option @@ -96,14 +96,14 @@ (N_ "Colors") (N_ "Background Color") "a" (N_ "General background color for report.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option (N_ "Colors") (N_ "Text Color") "b" (N_ "Normal body text color.") (list #x00 #x00 #x00 #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -117,7 +117,7 @@ (N_ "Colors") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -151,20 +151,20 @@ (list #xff #xff #x00 #xff) 255 #f)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell spacing") "a" (N_ "Space between table cells.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table border width") "c" (N_ "Bevel depth on tables.") 1 0 20 0 1)) @@ -174,47 +174,47 @@ (define (fancy-renderer options doc) (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (color-val - (lambda (section name) - (gnc:color-option->html - (gnc:lookup-option options section name)))) - (preparer (opt-val (N_ "General") (N_ "Preparer"))) - (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) - (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) - (links? (opt-val (N_ "General") (N_ "Enable Links"))) - (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) - (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) - (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) - (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) - (alternate-row-color (color-val (N_ "Colors") - (N_ "Alternate Table Cell Color"))) - (primary-subheading-color - (color-val (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color"))) - (secondary-subheading-color - (color-val (N_ "Colors") - (N_ "Sub-subheading/total Cell Color"))) - (grand-total-color (color-val (N_ "Colors") - (N_ "Grand Total Cell Color"))) - (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) - (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) - (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (color-val + (lambda (section name) + (gnc:color-option->html + (gnc:lookup-option options section name)))) + (preparer (opt-val (N_ "General") (N_ "Preparer"))) + (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) + (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) + (links? (opt-val (N_ "General") (N_ "Enable Links"))) + (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) + (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) + (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) + (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) + (alternate-row-color (color-val (N_ "Colors") + (N_ "Alternate Table Cell Color"))) + (primary-subheading-color + (color-val (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color"))) + (secondary-subheading-color + (color-val (N_ "Colors") + (N_ "Sub-subheading/total Cell Color"))) + (grand-total-color (color-val (N_ "Colors") + (N_ "Grand Total Cell Color"))) + (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) + (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) + (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) - (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) - (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) - (border (opt-val (N_ "Tables") (N_ "Table border width"))) + (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) + (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) + (border (opt-val (N_ "Tables") (N_ "Table border width"))) (headcolumn 0)) - ; center the document without elements inheriting anything + ; center the document without elements inheriting anything (gnc:html-document-add-object! ssdoc - (gnc:make-html-text "
")) + (gnc:make-html-text "
")) - (gnc:html-document-set-style! - ssdoc "body" + (gnc:html-document-set-style! + ssdoc "body" 'attribute (list "bgcolor" bgcolor) 'attribute (list "text" textcolor) 'attribute (list "link" linkcolor)) @@ -288,13 +288,13 @@ 'attribute (list "class" "centered-label-cell")) (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" (make-file-url bgpixmap)))) - + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" (make-file-url bgpixmap)))) + (gnc:html-document-set-style! - ssdoc "table" + ssdoc "table" 'attribute (list "border" border) 'attribute (list "cellspacing" spacing) 'attribute (list "cellpadding" padding)) @@ -306,32 +306,32 @@ (gnc:html-document-set-style! ssdoc "alternate-row" 'attribute (list "bgcolor" alternate-row-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "primary-subheading" 'attribute (list "bgcolor" primary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "secondary-subheading" 'attribute (list "bgcolor" secondary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "grand-total" 'attribute (list "bgcolor" grand-total-color) - 'tag "tr") + 'tag "tr") ;; don't surround marked-up links with (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) (let ((t (gnc:make-html-table))) - ;; we don't want a bevel for this table, but we don't want - ;; that to propagate + ;; we don't want a bevel for this table, but we don't want + ;; that to propagate (gnc:html-table-set-style! - t "table" + t "table" 'attribute (list "border" 0) 'inheritable? #f) @@ -339,18 +339,18 @@ (doc-headline (gnc:html-document-headline doc)) (headline (if (eq? doc-headline #f) title doc-headline))) - ; set the header column to be the 2nd when we have a logo - ; do this so that when logo is not present, the document - ; is perfectly centered - (if (and logopixmap (> (string-length logopixmap) 0)) - (set! headcolumn 1)) + ; set the header column to be the 2nd when we have a logo + ; do this so that when logo is not present, the document + ; is perfectly centered + (if (and logopixmap (> (string-length logopixmap) 0)) + (set! headcolumn 1)) - (gnc:html-table-set-cell! + (gnc:html-table-set-cell! t 1 headcolumn - (if show-preparer? - ;; title plus preparer info + (if show-preparer? + ;; title plus preparer info (gnc:make-html-text - (gnc:html-markup-h3 headline) + (gnc:html-markup-h3 headline) (gnc:html-markup-br) (_ "Prepared by: ") (gnc:html-markup-b preparer) @@ -362,48 +362,48 @@ (qof-print-date (current-time))) - ;; title only + ;; title only (gnc:make-html-text (gnc:html-markup-h3 headline)))) ) - + (if (and logopixmap - (not (string=? logopixmap ""))) - ;; check for logo image file name non blank - (gnc:html-table-set-cell! - t 0 0 + (not (string=? logopixmap ""))) + ;; check for logo image file name non blank + (gnc:html-table-set-cell! + t 0 0 (gnc:make-html-text - (gnc:html-markup-img (make-file-url logopixmap)))) ) + (gnc:html-markup-img (make-file-url logopixmap)))) ) (if (and headpixmap - (not (string=? headpixmap ""))) - ;; check for header image file name nonblank - (begin - (gnc:html-table-set-cell! + (not (string=? headpixmap ""))) + ;; check for header image file name nonblank + (begin + (gnc:html-table-set-cell! t 0 headcolumn (gnc:make-html-text - ;; XX: isn't there some way to apply the alignment to - ;; (gnc:html-markup-img headpixmap)? - (string-append - "
" - "" - "
"))) - ) - (gnc:html-table-set-cell! + ;; XX: isn't there some way to apply the alignment to + ;; (gnc:html-markup-img headpixmap)? + (string-append + "
" + "" + "
"))) + ) + (gnc:html-table-set-cell! t 0 headcolumn (gnc:make-html-text " "))) - (apply - gnc:html-table-set-cell! + (apply + gnc:html-table-set-cell! t 2 headcolumn (gnc:html-document-objects doc)) - + (gnc:html-document-add-object! ssdoc t)) (gnc:html-document-add-object! ssdoc - (gnc:make-html-text "
")) ;;TODO: make this a div instead of
(deprecated) + (gnc:make-html-text "
")) ;;TODO: make this a div instead of
(deprecated) ssdoc)) -(gnc:define-html-style-sheet +(gnc:define-html-style-sheet 'version 1.01 'name (N_ "Fancy") 'renderer fancy-renderer diff --git a/gnucash/report/stylesheets/stylesheet-footer.scm b/gnucash/report/stylesheets/stylesheet-footer.scm index 3464d582b9..5f22cbcc15 100644 --- a/gnucash/report/stylesheets/stylesheet-footer.scm +++ b/gnucash/report/stylesheets/stylesheet-footer.scm @@ -4,23 +4,23 @@ ;; ;; Copyright 2004 James Strandboge ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; ;; Free Software Foundation Voice: +1-617-542-5942 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; Boston, MA 02110-1301, USA gnu@gnu.org -;; +;; ;; Based on work from: ;; stylesheet-header.scm ;; Copyright 2000 Bill Gribble @@ -34,7 +34,7 @@ (define-module (gnucash report stylesheet-footer)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -43,34 +43,34 @@ (define (footer-options) (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - (opt-register + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + (opt-register (gnc:make-string-option (N_ "General") (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 (N_ "General") (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 (N_ "General") (N_ "Show preparer info") "c" - (N_ "Name of organization or company.") + (N_ "Name of organization or company.") #f)) - (opt-register + (opt-register (gnc:make-simple-boolean-option (N_ "General") (N_ "Enable Links") "d" - (N_ "Enable hyperlinks in reports.") + (N_ "Enable hyperlinks in reports.") #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 (gnc:make-text-option (N_ "General") @@ -95,14 +95,14 @@ (N_ "Heading Alignment") "c" (N_ "Banner for top of report.") 'left (list (vector 'left - (N_ "Left") - (N_ "Align the banner to the left.")) + (N_ "Left") + (N_ "Align the banner to the left.")) (vector 'center - (N_ "Center") - (N_ "Align the banner in the center.")) + (N_ "Center") + (N_ "Align the banner in the center.")) (vector 'right - (N_ "Right") - (N_ "Align the banner to the right.")) + (N_ "Right") + (N_ "Align the banner to the right.")) ))) (opt-register (gnc:make-pixmap-option @@ -115,14 +115,14 @@ (N_ "Colors") (N_ "Background Color") "a" (N_ "General background color for report.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option (N_ "Colors") (N_ "Text Color") "b" (N_ "Normal body text color.") (list #x00 #x00 #x00 #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -136,7 +136,7 @@ (N_ "Colors") (N_ "Table Cell Color") "c" (N_ "Default background for table cells.") (list #xff #xff #xff #xff) - 255 #f)) + 255 #f)) (opt-register (gnc:make-color-option @@ -170,20 +170,20 @@ (list #xff #xff #x00 #xff) 255 #f)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell spacing") "a" (N_ "Space between table cells.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.") 1 0 20 0 1)) - (opt-register - (gnc:make-number-range-option + (opt-register + (gnc:make-number-range-option (N_ "Tables") (N_ "Table border width") "c" (N_ "Bevel depth on tables.") 1 0 20 0 1)) @@ -193,48 +193,48 @@ (define (footer-renderer options doc) (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (color-val - (lambda (section name) - (gnc:color-option->html - (gnc:lookup-option options section name)))) - (preparer (opt-val (N_ "General") (N_ "Preparer"))) - (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) - (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) - (links? (opt-val (N_ "General") (N_ "Enable Links"))) - (footer-text (opt-val (N_ "General") (N_ "Footer"))) - (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) - (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) - (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) - (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) - (alternate-row-color (color-val (N_ "Colors") - (N_ "Alternate Table Cell Color"))) - (primary-subheading-color - (color-val (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color"))) - (secondary-subheading-color - (color-val (N_ "Colors") - (N_ "Sub-subheading/total Cell Color"))) - (grand-total-color (color-val (N_ "Colors") - (N_ "Grand Total Cell Color"))) - (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) - (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) - (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (color-val + (lambda (section name) + (gnc:color-option->html + (gnc:lookup-option options section name)))) + (preparer (opt-val (N_ "General") (N_ "Preparer"))) + (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) + (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) + (links? (opt-val (N_ "General") (N_ "Enable Links"))) + (footer-text (opt-val (N_ "General") (N_ "Footer"))) + (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) + (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) + (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) + (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) + (alternate-row-color (color-val (N_ "Colors") + (N_ "Alternate Table Cell Color"))) + (primary-subheading-color + (color-val (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color"))) + (secondary-subheading-color + (color-val (N_ "Colors") + (N_ "Sub-subheading/total Cell Color"))) + (grand-total-color (color-val (N_ "Colors") + (N_ "Grand Total Cell Color"))) + (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) + (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) + (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) - (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) - (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) - (border (opt-val (N_ "Tables") (N_ "Table border width"))) + (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) + (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) + (border (opt-val (N_ "Tables") (N_ "Table border width"))) (headcolumn 0)) - ; center the document without elements inheriting anything + ;; center the document without elements inheriting anything (gnc:html-document-add-object! ssdoc - (gnc:make-html-text "
")) + (gnc:make-html-text "
")) - (gnc:html-document-set-style! - ssdoc "body" + (gnc:html-document-set-style! + ssdoc "body" 'attribute (list "bgcolor" bgcolor) 'attribute (list "text" textcolor) 'attribute (list "link" linkcolor)) @@ -307,13 +307,13 @@ 'attribute (list "class" "centered-label-cell")) (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" (make-file-url bgpixmap)))) - + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" (make-file-url bgpixmap)))) + (gnc:html-document-set-style! - ssdoc "table" + ssdoc "table" 'attribute (list "border" border) 'attribute (list "cellspacing" spacing) 'attribute (list "cellpadding" padding)) @@ -325,48 +325,48 @@ (gnc:html-document-set-style! ssdoc "alternate-row" 'attribute (list "bgcolor" alternate-row-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "primary-subheading" 'attribute (list "bgcolor" primary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "secondary-subheading" 'attribute (list "bgcolor" secondary-subheading-color) - 'tag "tr") + 'tag "tr") (gnc:html-document-set-style! ssdoc "grand-total" 'attribute (list "bgcolor" grand-total-color) - 'tag "tr") + 'tag "tr") ;; don't surround marked-up links with (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) (let ((t (gnc:make-html-table))) - ;; we don't want a bevel for this table, but we don't want - ;; that to propagate + ;; we don't want a bevel for this table, but we don't want + ;; that to propagate (gnc:html-table-set-style! - t "table" + t "table" 'attribute (list "border" 0) 'inheritable? #f) - ; set the header column to be the 2nd when we have a logo - ; do this so that when logo is not present, the document - ; is perfectly centered + ;; set the header column to be the 2nd when we have a logo + ;; do this so that when logo is not present, the document + ;; is perfectly centered (if (and logopixmap (> (string-length logopixmap) 0)) - (set! headcolumn 1)) + (set! headcolumn 1)) (let* ((title (gnc:html-document-title doc)) (doc-headline (gnc:html-document-headline doc)) (headline (if (eq? doc-headline #f) title doc-headline))) - (gnc:html-table-set-cell! + (gnc:html-table-set-cell! t 1 headcolumn - (if show-preparer? - ;; title plus preparer info + (if show-preparer? + ;; title plus preparer info (gnc:make-html-text (gnc:html-markup-h3 headline) (gnc:html-markup-br) @@ -380,47 +380,48 @@ (qof-print-date (current-time))) - ;; title only + ;; title only (gnc:make-html-text (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)) - (begin - (gnc:html-table-set-cell! - t 0 0 - (gnc:make-html-text - (gnc:html-markup-img (make-file-url logopixmap)))))) - + (begin + (gnc:html-table-set-cell! + t 0 0 + (gnc:make-html-text + (gnc:html-markup-img (make-file-url logopixmap)))))) + (if (and headpixmap (> (string-length headpixmap) 0)) - (begin + (begin + (gnc:html-table-set-cell! + t 0 headcolumn + (gnc:make-html-text + (string-append + "
" + "" + "
"))) + ) (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text - (string-append - "
" - "" - "
"))) - ) - (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text " "))) - - (apply - gnc:html-table-set-cell! + t 0 headcolumn + (gnc:make-html-text " "))) + + (apply + gnc:html-table-set-cell! t 2 headcolumn (gnc:html-document-objects doc)) (gnc:html-document-add-object! ssdoc t) - ; I think this is the correct place to put the footer - (gnc:html-table-set-cell! + ;; I think this is the correct place to put the footer + (gnc:html-table-set-cell! t 3 headcolumn (gnc:make-html-text footer-text))) - (gnc:html-document-add-object! ssdoc (gnc:make-html-text "
")) ;;TODO: make this a div instead of
(deprecated) + (gnc:html-document-add-object! ssdoc (gnc:make-html-text "
")) + ;;TODO: make this a div instead of
(deprecated) ssdoc)) -(gnc:define-html-style-sheet +(gnc:define-html-style-sheet 'version 1 'name (N_ "Footer") 'renderer footer-renderer diff --git a/gnucash/report/stylesheets/stylesheet-head-or-tail.scm b/gnucash/report/stylesheets/stylesheet-head-or-tail.scm index c2cbfd4cc9..ad755094cc 100644 --- a/gnucash/report/stylesheets/stylesheet-head-or-tail.scm +++ b/gnucash/report/stylesheets/stylesheet-head-or-tail.scm @@ -35,7 +35,7 @@ (define-module (gnucash report stylesheet-head-or-tail)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash core-utils)) ; for gnc:version (use-modules (gnucash gettext)) @@ -45,9 +45,9 @@ (define (head-or-tail-options) (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) (opt-register (gnc:make-string-option (N_ "General") @@ -96,7 +96,7 @@ (N_ "Enable Links") "h" (N_ "Enable hyperlinks in reports.") #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 (gnc:make-text-option (N_ "General") @@ -151,14 +151,14 @@ (N_ "Heading Alignment") "c" (N_ "Banner for top of report.") 'left (list (vector 'left - (N_ "Left") - (N_ "Align the banner to the left.")) + (N_ "Left") + (N_ "Align the banner to the left.")) (vector 'center - (N_ "Center") - (N_ "Align the banner in the center.")) + (N_ "Center") + (N_ "Align the banner in the center.")) (vector 'right - (N_ "Right") - (N_ "Align the banner to the right.")) + (N_ "Right") + (N_ "Align the banner to the right.")) ))) (opt-register (gnc:make-pixmap-option @@ -249,54 +249,54 @@ (define (head-or-tail-renderer options doc) (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (color-val - (lambda (section name) - (gnc:color-option->html - (gnc:lookup-option options section name)))) - (preparer (opt-val (N_ "General") (N_ "Preparer"))) - (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) - (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) - (show-receiver? (opt-val (N_ "General") (N_ "Show receiver info"))) - (show-date? (opt-val (N_ "General") (N_ "Show 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"))) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (color-val + (lambda (section name) + (gnc:color-option->html + (gnc:lookup-option options section name)))) + (preparer (opt-val (N_ "General") (N_ "Preparer"))) + (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) + (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) + (show-receiver? (opt-val (N_ "General") (N_ "Show receiver info"))) + (show-date? (opt-val (N_ "General") (N_ "Show 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-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-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-gnucash-version-at-bottom? (opt-val (N_ "General") (N_ "Show GnuCash version at bottom"))) - (links? (opt-val (N_ "General") (N_ "Enable Links"))) - (additional-comments (opt-val (N_ "General") (N_ "Additional Comments"))) - (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) - (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) - (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) - (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) - (alternate-row-color (color-val (N_ "Colors") - (N_ "Alternate Table Cell Color"))) - (primary-subheading-color - (color-val (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color"))) - (secondary-subheading-color - (color-val (N_ "Colors") - (N_ "Sub-subheading/total Cell Color"))) - (grand-total-color (color-val (N_ "Colors") - (N_ "Grand Total Cell Color"))) - (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) - (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) - (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) + (links? (opt-val (N_ "General") (N_ "Enable Links"))) + (additional-comments (opt-val (N_ "General") (N_ "Additional Comments"))) + (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) + (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) + (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) + (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) + (alternate-row-color (color-val (N_ "Colors") + (N_ "Alternate Table Cell Color"))) + (primary-subheading-color + (color-val (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color"))) + (secondary-subheading-color + (color-val (N_ "Colors") + (N_ "Sub-subheading/total Cell Color"))) + (grand-total-color (color-val (N_ "Colors") + (N_ "Grand Total Cell Color"))) + (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) + (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) + (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment")))) - (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) - (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) - (border (opt-val (N_ "Tables") (N_ "Table border width"))) + (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) + (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) + (border (opt-val (N_ "Tables") (N_ "Table border width"))) (headcolumn 0)) - ; center the document without elements inheriting anything + ;; center the document without elements inheriting anything (gnc:html-document-add-object! ssdoc - (gnc:make-html-text "
")) + (gnc:make-html-text "
")) (gnc:html-document-set-style! ssdoc "body" @@ -372,10 +372,10 @@ 'attribute (list "class" "centered-label-cell")) (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" (make-file-url bgpixmap)))) + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" (make-file-url bgpixmap)))) (gnc:html-document-set-style! ssdoc "table" @@ -406,7 +406,7 @@ ;; don't surround marked-up links with (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) @@ -418,122 +418,122 @@ 'attribute (list "border" 0) 'inheritable? #f) - ; set the header column to be the 2nd when we have a logo - ; do this so that when logo is not present, the document - ; is perfectly centered + ;; set the header column to be the 2nd when we have a logo + ;; do this so that when logo is not present, the document + ;; is perfectly centered (if (and logopixmap (> (string-length logopixmap) 0)) - (set! headcolumn 1)) + (set! headcolumn 1)) (let* ((title (gnc:html-document-title doc)) (doc-headline (gnc:html-document-headline doc)) (headline (if (eq? doc-headline #f) title doc-headline))) (gnc:html-table-set-cell! - t 1 headcolumn - ;; print title - (gnc:make-html-text - (gnc:html-markup-h3 headline)) - (if (and show-preparer? (not show-preparer-at-bottom?)) - ;; print preparer info as additional header info - (gnc:make-html-text + t 1 headcolumn + ;; print title + (gnc:make-html-text + (gnc:html-markup-h3 headline)) + (if (and show-preparer? (not show-preparer-at-bottom?)) + ;; print preparer info as additional header info + (gnc:make-html-text (gnc:html-markup-i - (_ "Prepared by: ") - (gnc:html-markup-b preparer) - ) + (_ "Prepared by: ") + (gnc:html-markup-b preparer) + ) (gnc:html-markup-br) - ) - " " - ) - (if (and show-receiver? (not show-receiver-at-bottom?)) - ;; print receiver info as additional header info - (gnc:make-html-text + ) + " " + ) + (if (and show-receiver? (not show-receiver-at-bottom?)) + ;; print receiver info as additional header info + (gnc:make-html-text (gnc:html-markup-i - (_ "Prepared for: ") - (gnc:html-markup-b prepared-for) - (gnc:html-markup-br) + (_ "Prepared for: ") + (gnc:html-markup-b prepared-for) + (gnc:html-markup-br) + ) ) - ) - " " - ) - (if (and show-date? (not 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: ") - (qof-print-date (gnc:get-today)) - ) - (gnc:html-markup-br) - ) - ) - " " - ) - (if (and show-gnucash-version? (not show-gnucash-version-at-bottom?)) - ;; print the GnuCash version string as additional header info - (gnc:make-html-text + " " + ) + (if (and show-date? (not 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: ") + (qof-print-date (gnc:get-today)) + ) + (gnc:html-markup-br) + ) + ) + " " + ) + (if (and show-gnucash-version? (not show-gnucash-version-at-bottom?)) + ;; print the GnuCash version string as additional header info + (gnc:make-html-text (gnc:html-markup-i - "GnuCash " - gnc:version - ) + "GnuCash " + gnc:version + ) (gnc:html-markup-br) - ) - " " - ) - (if (not show-comments-at-bottom?) - ;; print additional comments as additional header info - (gnc:make-html-text + ) + " " + ) + (if (not show-comments-at-bottom?) + ;; print additional comments as additional header info + (gnc:make-html-text (gnc:html-markup-br) (gnc:html-markup-i additional-comments) (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) - ) - " " - ) + ) + " " + ) + ) ) - ) - ; only setup an image if we specified one + ;; only setup an image if we specified one (if (and logopixmap (> (string-length logopixmap) 0)) - (begin - (gnc:html-table-set-cell! - t 0 0 - (gnc:make-html-text - (gnc:html-markup-img (make-file-url logopixmap)))))) + (begin + (gnc:html-table-set-cell! + t 0 0 + (gnc:make-html-text + (gnc:html-markup-img (make-file-url logopixmap)))))) (if (and headpixmap (> (string-length headpixmap) 0)) - (begin + (begin + (gnc:html-table-set-cell! + t 0 headcolumn + (gnc:make-html-text + (string-append + "
" + "" + "
"))) + ) (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text - (string-append - "
" - "" - "
"))) - ) - (gnc:html-table-set-cell! - t 0 headcolumn - (gnc:make-html-text " "))) + t 0 headcolumn + (gnc:make-html-text " "))) (apply gnc:html-table-set-cell! @@ -541,88 +541,88 @@ (gnc:html-document-objects doc)) (gnc:html-document-add-object! ssdoc t) - ; I think this is the correct place to put the footer - (gnc:html-table-set-cell! + ;; I think this is the correct place to put the footer + (gnc:html-table-set-cell! t 3 headcolumn ;;(gnc:make-html-text additional-comments) - ;; add separator line if any additional header info is printed - (if (or - (and show-preparer? show-preparer-at-bottom?) - (and show-receiver? show-receiver-at-bottom?) - (and show-date? show-date-time-at-bottom?) - (and show-gnucash-version? show-gnucash-version-at-bottom?) - show-comments-at-bottom? + ;; add separator line if any additional header info is printed + (if (or + (and show-preparer? show-preparer-at-bottom?) + (and show-receiver? show-receiver-at-bottom?) + (and show-date? show-date-time-at-bottom?) + (and show-gnucash-version? show-gnucash-version-at-bottom?) + show-comments-at-bottom? ) - (gnc:make-html-text + (gnc:make-html-text (gnc:html-markup-br) - ) - " " - ) - (if (and show-preparer? show-preparer-at-bottom?) - ;; print preparer info as additional header info - (gnc:make-html-text + ) + " " + ) + (if (and show-preparer? show-preparer-at-bottom?) + ;; print preparer info as additional header info + (gnc:make-html-text (gnc:html-markup-i - (_ "Prepared by: ") - (gnc:html-markup-b preparer) - ) + (_ "Prepared by: ") + (gnc:html-markup-b preparer) + ) (gnc:html-markup-br) - ) - " " - ) - (if (and show-receiver? show-receiver-at-bottom?) - ;; print receiver info as additional header info - (gnc:make-html-text + ) + " " + ) + (if (and show-receiver? show-receiver-at-bottom?) + ;; print receiver info as additional header info + (gnc:make-html-text (gnc:html-markup-i - (_ "Prepared for: ") - (gnc:html-markup-b prepared-for) - ) + (_ "Prepared for: ") + (gnc:html-markup-b prepared-for) + ) (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: ") - (qof-print-date (gnc:get-today)) + " " + ) + (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) - ) - ) - ) - " " - ) - (if (and show-gnucash-version? show-gnucash-version-at-bottom?) - ;; print the GnuCash version string as additional header info - (gnc:make-html-text + ) + (gnc:make-html-text + (gnc:html-markup-i + (_ "Report Creation Date: ") + (qof-print-date (gnc:get-today)) + (gnc:html-markup-br) + ) + ) + ) + " " + ) + (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 - (_ "GnuCash ") - gnc:version + (_ "GnuCash ") + 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) - ) - " " - ) - (if show-comments-at-bottom? - ;; print additional comments as additional header info - (gnc:make-html-text + (gnc:html-markup-i additional-comments) (gnc:html-markup-br) - (gnc:html-markup-i additional-comments) - (gnc:html-markup-br) - ) - " " - ) - )) + ) + " " + ) + )) (gnc:html-document-add-object! ssdoc (gnc:make-html-text "
")) ;;TODO: make this a div instead of
(deprecated) ssdoc)) diff --git a/gnucash/report/stylesheets/stylesheet-plain.scm b/gnucash/report/stylesheets/stylesheet-plain.scm index 2a9d7e3348..97983a4b1f 100644 --- a/gnucash/report/stylesheets/stylesheet-plain.scm +++ b/gnucash/report/stylesheets/stylesheet-plain.scm @@ -24,7 +24,7 @@ (define-module (gnucash report stylesheet-plain)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash core-utils)) (use-modules (gnucash gettext)) @@ -39,89 +39,89 @@ ;; it's supposed to be lightweight and unobtrusive. (define (plain-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 - (gnc:make-pixmap-option - (N_ "General") - (N_ "Background Pixmap") "b" (N_ "Background tile for reports.") - "")) - (opt-register - (gnc:make-simple-boolean-option - (N_ "General") - (N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.") - #t)) - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Alternate Table Cell Color") "a" (N_ "Background color for alternate lines.") - (list #xff #xff #xff #xff) - 255 #f)) - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table cell spacing") "a" (N_ "Space between table cells.") - 0 0 20 0 1)) - (opt-register - (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) + (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 + (gnc:make-pixmap-option + (N_ "General") + (N_ "Background Pixmap") "b" (N_ "Background tile for reports.") + "")) + (opt-register + (gnc:make-simple-boolean-option + (N_ "General") + (N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.") + #t)) + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Alternate Table Cell Color") "a" (N_ "Background color for alternate lines.") + (list #xff #xff #xff #xff) + 255 #f)) + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table cell spacing") "a" (N_ "Space between table cells.") + 0 0 20 0 1)) + (opt-register + (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) (let* - ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (bgcolor - (gnc:color-option->html - (gnc:lookup-option options - "General" - "Background Color"))) - (bgpixmap (opt-val "General" "Background Pixmap")) - (links? (opt-val "General" "Enable Links")) - (alternate-row-color - (gnc:color-option->html - (gnc:lookup-option options - "Colors" - "Alternate Table Cell Color"))) - (spacing (opt-val "Tables" "Table cell spacing")) - (padding (opt-val "Tables" "Table cell padding")) - (border (opt-val "Tables" "Table border width")) - ) + ((ssdoc (gnc:make-html-document)) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (bgcolor + (gnc:color-option->html + (gnc:lookup-option options + "General" + "Background Color"))) + (bgpixmap (opt-val "General" "Background Pixmap")) + (links? (opt-val "General" "Enable Links")) + (alternate-row-color + (gnc:color-option->html + (gnc:lookup-option options + "Colors" + "Alternate Table Cell Color"))) + (spacing (opt-val "Tables" "Table cell spacing")) + (padding (opt-val "Tables" "Table cell padding")) + (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! 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! - ssdoc "table" - 'attribute (list "border" border) - 'attribute (list "cellspacing" spacing) - 'attribute (list "cellpadding" padding)) + ssdoc "table" + 'attribute (list "border" border) + 'attribute (list "cellspacing" spacing) + 'attribute (list "cellpadding" padding)) (gnc:html-document-set-style! ssdoc "column-heading-left" @@ -189,13 +189,13 @@ 'attribute (list "class" "centered-label-cell")) (gnc:html-document-set-style! - ssdoc "normal-row" - 'tag "tr") + ssdoc "normal-row" + 'tag "tr") (gnc:html-document-set-style! - ssdoc "alternate-row" - 'tag "tr" - 'attribute (list "bgcolor" alternate-row-color)) + ssdoc "alternate-row" + 'tag "tr" + 'attribute (list "bgcolor" alternate-row-color)) (gnc:html-document-set-style! ssdoc "primary-subheading" @@ -212,9 +212,9 @@ ;; don't surround marked-up links with (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) @@ -223,13 +223,13 @@ (headline (if (eq? doc-headline #f) title doc-headline))) (if headline - (gnc:html-document-add-object! - ssdoc - (gnc:make-html-text - (gnc:html-markup-h3 headline))))) + (gnc:html-document-add-object! + ssdoc + (gnc:make-html-text + (gnc:html-markup-h3 headline))))) (gnc:html-document-append-objects! ssdoc - (gnc:html-document-objects doc)) + (gnc:html-document-objects doc)) ssdoc)) diff --git a/gnucash/report/stylesheets/stylesheets.scm b/gnucash/report/stylesheets/stylesheets.scm index abaee4a81d..3f810a7ebb 100644 --- a/gnucash/report/stylesheets/stylesheets.scm +++ b/gnucash/report/stylesheets/stylesheets.scm @@ -2,7 +2,7 @@ ;; stylesheets.scm ;; 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 @@ -26,7 +26,7 @@ (define-module (gnucash report stylesheets)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash report stylesheet-plain)) (use-modules (gnucash report stylesheet-fancy)) (use-modules (gnucash report stylesheet-footer))