[GNC] What is wrong with this custom stylesheet code?
Robert Heller
heller at deepsoft.com
Mon Jul 3 10:16:12 EDT 2023
I have written a style sheet module and it *seems* to be loading now, but
things are wonky any I don't know why.
What I am *trying to go:
1) Put my company letterhead across the top of the invoice
2) Put a "button image" (Payments by PayPal) under the invoice table.
My custom stylesheet code adds two options: the button image and some
(optional) text to put under the button image (typically the e-mail address to
use as the payment target).
Several things are not working:
If I use the Edit->Style Sheets options and create a new stylesheet from my
template, the addition options are not available (why?) If I just edit the
template itselt (with Edit->Style Sheets) I can set the header image and the
button image, and the header image shows up, but not the button image (why?),
and the options not saved across runs (why?).
This code used to work just fine with V 2.6. What has changed? What do I
need to change? The attached code was copied and modified from the V4.14
source tree (footer.scm), but obviously something is wrong somewhere.
;;*****************************************************************************
;;
;; System :
;; Module :
;; Object Name : $RCSfile$
;; Revision : $Revision$
;; Date : $Date$
;; Author : $Author$
;; Created By : Robert Heller
;; Created : Sun Jul 2 15:09:23 2023
;; Last Modified : <230703.1014>
;;
;; Description
;;
;; Notes
;;
;; History
;;
;;*****************************************************************************
;;# @copyright
;; Copyright (C) 2023 Robert Heller D/B/A Deepwoods Software
;; 51 Locke Hill Road
;; Wendell, MA 01379-9728
;;
;; 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, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; @file dws-stylesheet.scm
;; @author Robert Heller
;; @date Sun Jul 2 15:09:23 2023
;;
;;
;;*****************************************************************************
(define-module (gnucash report stylesheets DWS))
(use-modules (gnucash engine))
(use-modules (gnucash utilities))
(use-modules (gnucash core-utils))
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
(use-modules (gnucash html))
(define (dws-options)
(let* ((options (gnc:new-options))
(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.")
""))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.")
""))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Show preparer info") "c"
(N_ "Name of organization or company.")
#f))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.")
#t))
(opt-register
(gnc:make-text-option
(N_ "General")
(N_ "Footer") "e"
(N_ "String to be placed as a footer.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Background Tile") "a" (N_ "Background tile for reports.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
;;; Translators: Banner is an image like Logo.
(N_ "Heading Banner") "b" (N_ "Banner for top of report.")
""))
(opt-register
(gnc:make-multichoice-option
(N_ "Images")
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left
(list (vector 'left (N_ "Left"))
(vector 'center (N_ "Center"))
(vector 'right (N_ "Right")))))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Logo") "d" (N_ "Company logo image.")
""))
;; RPH Mon Oct 8 10:46:26 2007
;; Button image and associated text options
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Button Image") "e" (N_ "Button image.")
""))
(opt-register
(gnc:make-string-option
(N_ "Images")
(N_ "Button Image Text") "f" (N_ "Text to place under Button Image.")
""))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff)
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))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.")
(list #xb2 #x22 #x22 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Alternate Table Cell Color") "d"
(N_ "Default alternate background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Subheading/Subtotal Cell Color") "e"
(N_ "Default color for subtotal rows.")
(list #xee #xe8 #xaa #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Sub-subheading/total Cell Color") "f"
(N_ "Color for subsubtotals.")
(list #xfa #xfa #xd2 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Grand Total Cell Color") "g"
(N_ "Color for grand totals.")
(list #xff #xff #x00 #xff)
255 #f))
(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
(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
(N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1))
(register-font-options options)
options))
(define (dws-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 "General" "Preparer"))
(prepared-for (opt-val "General" "Prepared for"))
(show-preparer? (opt-val "General" "Show preparer info"))
(links? (opt-val "General" "Enable Links"))
(footer-text (opt-val "General" "Footer"))
(bgcolor (color-val "Colors" "Background Color"))
(textcolor (color-val "Colors" "Text Color"))
(linkcolor (color-val "Colors" "Link Color"))
(normal-row-color (color-val "Colors" "Table Cell Color"))
(alternate-row-color (color-val "Colors" "Alternate Table Cell Color"))
(primary-subheading-color
(color-val "Colors" "Subheading/Subtotal Cell Color"))
(secondary-subheading-color
(color-val "Colors" "Sub-subheading/total Cell Color"))
(grand-total-color (color-val "Colors" "Grand Total Cell Color"))
(bgpixmap (opt-val "Images" "Background Tile"))
(headpixmap (opt-val "Images" "Heading Banner"))
(logopixmap (opt-val "Images" "Logo"))
;; Fetch Button image options
(buttonpixmap (opt-val (N_ "Images") (N_ "Button Image")))
(buttontext (opt-val (N_ "Images") (N_ "Button Image Text")))
(align (gnc:value->string (opt-val "Images" "Heading Alignment")))
(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)
'attribute (list "text" textcolor)
'attribute (list "link" linkcolor))
;;;;
;;;;
;;;;
(gnc:html-document-set-style!
ssdoc "column-heading-left"
'tag "th"
'attribute (list "class" "column-heading-left"))
(gnc:html-document-set-style!
ssdoc "column-heading-center"
'tag "th"
'attribute (list "class" "column-heading-center"))
(gnc:html-document-set-style!
ssdoc "column-heading-right"
'tag "th"
'attribute (list "class" "column-heading-right"))
(gnc:html-document-set-style!
ssdoc "date-cell"
'tag "td"
'attribute (list "class" "date-cell"))
(gnc:html-document-set-style!
ssdoc "anchor-cell"
'tag "td"
'attribute (list "class" "anchor-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "class" "number-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell-neg"
'tag "td"
'attribute (list "class" "number-cell neg"))
(gnc:html-document-set-style!
ssdoc "number-header"
'tag "th"
'attribute (list "class" "number-header"))
(gnc:html-document-set-style!
ssdoc "text-cell"
'tag "td"
'attribute (list "class" "text-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell"
'tag '("td")
'attribute (list "class" "total-number-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell-neg"
'tag '("td")
'attribute (list "class" "total-number-cell neg"))
(gnc:html-document-set-style!
ssdoc "total-label-cell"
'tag '("td")
'attribute (list "class" "total-label-cell"))
(gnc:html-document-set-style!
ssdoc "centered-label-cell"
'tag '("td")
'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))))
(gnc:html-document-set-style!
ssdoc "table"
'attribute (list "border" border)
'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
'tag "tr")
;; don't surround marked-up links with <a> </a>
(if (not links?)
(gnc:html-document-set-style!
ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table))
;; 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
(headcolumn (if (and logopixmap (> (string-length logopixmap) 0))
1 0)))
;; we don't want a bevel for this table, but we don't want
;; that to propagate
(gnc:html-table-set-style!
t "table"
'attribute (list "border" 0)
'attribute (list "style" "margin-left:auto; margin-right:auto")
'inheritable? #f)
(let* ((headline (or (gnc:html-document-headline doc)
(gnc:html-document-title doc))))
(gnc:html-table-set-cell!
t 1 headcolumn
(if show-preparer?
;; title plus preparer info
(gnc:make-html-text
(gnc:html-markup-h3 headline)
(gnc:html-markup-br)
(G_ "Prepared by: ")
(gnc:html-markup-b preparer)
(gnc:html-markup-br)
(G_ "Prepared for: ")
(gnc:html-markup-b prepared-for)
(gnc:html-markup-br)
(G_ "Date: ")
(qof-print-date
(current-time)))
;; title only
(gnc:make-html-text
(gnc:html-markup-h3 headline)))))
;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0))
(gnc:html-table-set-cell!
t 0 0
(gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))
(display "*** headpixmap is ")(display headpixmap)(newline)
(if (and headpixmap (> (string-length headpixmap) 0))
(let* ((div (gnc:html-markup-img (make-file-url headpixmap)))
(cell (gnc:make-html-table-cell (gnc:make-html-text div))))
(gnc:html-table-cell-set-style! cell "td" 'attribute `("align" ,align))
(gnc:html-table-set-cell! t 0 headcolumn cell))
(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))
(display "*** buttonpixmap is ")(display buttonpixmap)(newline)
(display "*** buttontext is ")(display buttontext)(newline)
(if (and buttonpixmap
(not (string=? buttonpixmap "")))
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text
(gnc:html-markup-img (make-file-url buttonpixmap))
;; Include additional text (typically E-Mail address used for
;; PayPal payments.
(if (and buttontext (not (string=? buttontext "")))
(string-append "<BR>" buttontext "<BR>") ) )) )
(gnc:html-document-add-object! ssdoc t)
(gnc:html-table-set-cell!
t 3 headcolumn
(gnc:make-html-text footer-text)))
ssdoc))
(gnc:define-html-style-sheet
'version 3.0
'name (N_ "DWS Stylesheet")
'renderer dws-renderer
'options-generator dws-options)
(gnc:make-html-style-sheet "DWS_Stylesheet" (N_ "DWS Stylesheet"))
--
Robert Heller -- Cell: 413-658-7953 GV: 978-633-5364
Deepwoods Software -- Custom Software Services
http://www.deepsoft.com/ -- Linux Administration Services
heller at deepsoft.com -- Webhosting Services
More information about the gnucash-user
mailing list