1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2;; html-utilities.scm: Useful functions when using the HTML generator. 3;; 4;; Modified slightly by David Montenegro 2004.06.18. 5;; 6;; Copyright 2001 Christian Stimming <stimming@tu-harburg.de> 7;; This program is free software; you can redistribute it and/or 8;; modify it under the terms of the GNU General Public License as 9;; published by the Free Software Foundation; either version 2 of 10;; the License, or (at your option) any later version. 11;; 12;; This program is distributed in the hope that it will be useful, 13;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16;; 17;; You should have received a copy of the GNU General Public License 18;; along with this program; if not, contact: 19;; 20;; Free Software Foundation Voice: +1-617-542-5942 21;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 22;; Boston, MA 02110-1301, USA gnu@gnu.org 23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 25(define-module (gnucash report html-utilities)) 26 27(use-modules (gnucash core-utils)) 28(use-modules (gnucash engine)) 29(use-modules (gnucash utilities)) 30(use-modules (gnucash app-utils)) 31(use-modules (gnucash html)) 32(use-modules (gnucash report report-core)) 33(use-modules (gnucash report report-utilities)) 34(use-modules (gnucash report html-style-info)) 35(use-modules (gnucash report html-text)) 36(use-modules (gnucash report html-table)) 37(use-modules (ice-9 match)) 38 39(export gnc:html-make-empty-cell) 40(export gnc:html-make-empty-cells) 41(export gnc:account-anchor-text) 42(export gnc:split-anchor-text) 43(export gnc:transaction-anchor-text) 44(export gnc:transaction-doclink-anchor-text) 45(export gnc:report-anchor-text) 46(export gnc:make-report-anchor) 47(export gnc:html-account-anchor) 48(export gnc:html-split-anchor) 49(export gnc:html-transaction-anchor) 50(export gnc:html-transaction-doclink-anchor) 51(export gnc:html-invoice-doclink-anchor) 52(export gnc:html-price-anchor) 53(export gnc:customer-anchor-text) 54(export gnc:job-anchor-text) 55(export gnc:vendor-anchor-text) 56(export gnc:invoice-anchor-text) 57(export gnc:owner-anchor-text) 58(export gnc:owner-report-text) 59(export gnc:assign-colors) 60(export gnc:html-table-append-ruler!) 61(export gnc:html-make-exchangerates) 62(export gnc:html-make-rates-table) 63(export gnc:html-render-options-changed) 64(export gnc:html-make-generic-warning) 65(export gnc:html-make-no-account-warning) 66(export gnc:html-make-generic-budget-warning) 67(export gnc:html-make-generic-options-warning) 68(export gnc:html-make-generic-simple-warning) 69(export gnc:html-make-empty-data-warning) 70(export gnc:html-make-options-link) 71(export gnc:html-js-include) 72(export gnc:html-css-include) 73 74;; returns a list with n #f (empty cell) values 75(define (gnc:html-make-empty-cell) #f) 76(define (gnc:html-make-empty-cells n) 77 (if (> n 0) 78 (cons #f (gnc:html-make-empty-cells (- n 1))) 79 (list))) 80 81(define (gnc:register-guid type guid) 82 (gnc-build-url URL-TYPE-REGISTER (string-append type guid) "")) 83 84(define (gnc:account-anchor-text acct) 85 (gnc:register-guid "acct-guid=" (gncAccountGetGUID acct))) 86 87(define (gnc:split-anchor-text split) 88 (gnc:register-guid "split-guid=" (gncSplitGetGUID split))) 89 90(define (gnc:transaction-anchor-text trans) 91 (gnc:register-guid "trans-guid=" (gncTransGetGUID trans))) 92 93(define (gnc:transaction-doclink-anchor-text trans) 94 (gnc:register-guid "trans-doclink-guid=" (gncTransGetGUID trans))) 95 96(define (gnc:invoice-doclink-anchor-text invoice) 97 (gnc:register-guid "invoice-doclink-guid=" (gncInvoiceReturnGUID invoice))) 98 99(define (gnc:report-anchor-text report-id) 100 (gnc-build-url URL-TYPE-REPORT 101 (string-append "id=" (number->string report-id)) 102 "")) 103 104(define (gnc:price-anchor-text price) 105 (gnc-build-url URL-TYPE-PRICE 106 (string-append "price-guid=" (gncPriceGetGUID price)) 107 "")) 108 109(define (guid-ref idstr type guid) 110 (gnc-build-url type (string-append idstr guid) "")) 111 112(define (gnc:customer-anchor-text customer) 113 (guid-ref "customer=" URL-TYPE-CUSTOMER (gncCustomerReturnGUID customer))) 114 115(define (gnc:job-anchor-text job) 116 (guid-ref "job=" URL-TYPE-JOB (gncJobReturnGUID job))) 117 118(define (gnc:vendor-anchor-text vendor) 119 (guid-ref "vendor=" URL-TYPE-VENDOR (gncVendorReturnGUID vendor))) 120 121(define (gnc:employee-anchor-text employee) 122 (guid-ref "employee=" URL-TYPE-EMPLOYEE (gncEmployeeReturnGUID employee))) 123 124(define (gnc:invoice-anchor-text invoice) 125 (guid-ref "invoice=" URL-TYPE-INVOICE (gncInvoiceReturnGUID invoice))) 126 127(define (gnc:owner-anchor-text owner) 128 (let ((type (gncOwnerGetType (gncOwnerGetEndOwner owner)))) 129 (cond 130 ((eqv? type GNC-OWNER-CUSTOMER) 131 (gnc:customer-anchor-text (gncOwnerGetCustomer owner))) 132 133 ((eqv? type GNC-OWNER-VENDOR) 134 (gnc:vendor-anchor-text (gncOwnerGetVendor owner))) 135 136 ((eqv? type GNC-OWNER-EMPLOYEE) 137 (gnc:employee-anchor-text (gncOwnerGetEmployee owner))) 138 139 ((eqv? type GNC-OWNER-JOB) 140 (gnc:job-anchor-text (gncOwnerGetJob owner))) 141 142 (else 143 "")))) 144 145(define* (gnc:owner-report-text owner acc #:optional date) 146 (let* ((end-owner (gncOwnerGetEndOwner owner)) 147 (type (gncOwnerGetType end-owner))) 148 (gnc-build-url 149 URL-TYPE-OWNERREPORT 150 (string-append 151 (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:") 152 ((eqv? type GNC-OWNER-VENDOR) "owner=v:") 153 ((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:") 154 (else "unknown-type=")) 155 (gncOwnerReturnGUID end-owner) 156 (if date (format #f "&enddate=~a" date) "") 157 (if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc)))) 158 ""))) 159 160;; Make a new report and return the anchor to it. The new report of 161;; type 'reportname' will have the option values copied from 162;; 'src-options', and additionally this function sets all options 163;; according to 'optionlist'. Each element of optionlist is a list of 164;; section, name, and value of the function. 165(define (gnc:make-report-anchor reportname src-report 166 optionlist) 167 (let ((src-options (gnc:report-options src-report)) 168 (options (gnc:make-report-options reportname))) 169 (if options 170 (begin 171 (gnc:options-copy-values src-options options) 172 (for-each 173 (lambda (l) 174 (let ((o (gnc:lookup-option options (car l) (cadr l)))) 175 (if o 176 (gnc:option-set-value o (caddr l)) 177 (warn "gnc:make-report-anchor:" reportname 178 " No such option: " (car l) (cadr l))))) 179 optionlist) 180 (let ((id (gnc:make-report reportname options))) 181 (gnc:report-anchor-text id))) 182 (warn "gnc:make-report-anchor: No such report: " reportname)))) 183 184 185;; returns the account name as html-text and anchor to the register. 186(define (gnc:html-account-anchor acct) 187 (gnc:make-html-text (if (and acct (not (null? acct))) 188 (gnc:html-markup-anchor 189 (gnc:account-anchor-text acct) 190 (xaccAccountGetName acct)) 191 ""))) 192 193(define (gnc:html-split-anchor split text) 194 (gnc:make-html-text (if (not (null? (xaccSplitGetAccount split))) 195 (gnc:html-markup-anchor 196 (gnc:split-anchor-text split) 197 text) 198 text))) 199 200(define (gnc:html-transaction-anchor trans text) 201 (gnc:make-html-text (gnc:html-markup-anchor 202 (gnc:transaction-anchor-text trans) 203 text))) 204 205(define (gnc:html-transaction-doclink-anchor trans text) 206 (gnc:make-html-text (gnc:html-markup-anchor 207 (gnc:transaction-doclink-anchor-text trans) 208 text))) 209 210(define (gnc:html-invoice-doclink-anchor invoice text) 211 (gnc:make-html-text (gnc:html-markup-anchor 212 (gnc:invoice-doclink-anchor-text invoice) 213 text))) 214 215(define (gnc:html-price-anchor price value) 216 (gnc:make-html-text (if price 217 (gnc:html-markup-anchor 218 (gnc:price-anchor-text price) 219 (if value 220 value 221 (gnc-price-get-value price))) 222 value))) 223 224(define (gnc:assign-colors num-colors) 225 ;; default CSS colours 226 ;; (define base-colors '("red" "orange" "yellow" "green" 227 ;; "cyan" "blue" "purple" "magenta" 228 ;; "orchid" "khaki" "gold" "orange" 229 ;; "red3" "orange3" "yellow3" "green3" 230 ;; "cyan3" "blue3" "purple3" "magenta3" 231 ;; "orchid3" "khaki3" "gold3" "orange3")) 232 233 ;; new base-colors from http://clrs.cc/ and flatuicolors.com 234 (define base-colors (list "#FF4136" "#FF851B" "#FFDC00" "#2ECC40" 235 "#0074D9" "#001f3f" "#85144b" "#7FDBFF" 236 "#F012BE" "#3D9970" "#39CCCC" "#f39c12" 237 "#e74c3c" "#e67e22" "#9b59b6" "#8e44ad" 238 "#16a085" "#d35400")) 239 (let lp ((i 0) (result '()) (colors base-colors)) 240 (cond 241 ((<= num-colors i) (reverse result)) 242 ((null? colors) (lp (1+ i) (cons (car base-colors) result) (cdr base-colors))) 243 (else (lp (1+ i) (cons (car colors) result) (cdr colors)))))) 244 245(define (gnc:html-table-append-ruler! table colspan) 246 (gnc:html-table-append-row! 247 table (list (gnc:make-html-table-cell/size 248 1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))) 249 250;; Create a html-table of all exchange rates. The report-commodity is 251;; 'common-commodity', the exchange rates are given through the 252;; function 'exchange-fn' and the 'accounts' determine which 253;; commodities to show. Returns a html-object, a <html-table>. 254(define (gnc:html-make-exchangerates common-commodity exchange-fn accounts) 255 (issue-deprecation-warning 256 "gnc:html-make-exchangerates is deprecated. use gnc:html-make-rates-table instead.") 257 (let* ((comm-list (gnc:accounts-get-commodities accounts common-commodity)) 258 (entries (length comm-list)) 259 (markup (lambda (c) (gnc:make-html-table-cell/markup "number-cell" c))) 260 (table (gnc:make-html-table))) 261 (unless (= 0 entries) 262 (for-each 263 (lambda (commodity) 264 (let* ((orig-amt (gnc:make-gnc-monetary commodity 1)) 265 (exchanged (exchange-fn orig-amt common-commodity)) 266 (conv-amount (gnc:gnc-monetary-amount exchanged))) 267 (gnc:html-table-append-row! 268 table (list (markup orig-amt) 269 (markup (gnc:default-price-renderer common-commodity 270 conv-amount)))))) 271 comm-list) 272 (gnc:html-table-set-col-headers! 273 table (list (gnc:make-html-table-header-cell/size 274 1 2 (NG_ "Exchange rate" "Exchange rates" entries))))) 275 table)) 276 277;; Create a html-table of all prices. The report-currency is 278;; 'currency', The prices are given through the function 'price-fn' 279;; and the 'accounts' determine which commodities to show. Returns a 280;; html-object, a <html-table>. price-fn is easily obtained from 281;; gnc:case-price-fn 282(define (gnc:html-make-rates-table currency price-fn accounts) 283 (define (cell c) (gnc:make-html-table-cell/markup "number-cell" c)) 284 (define table (gnc:make-html-table)) 285 (let lp ((comm-list (gnc:accounts-get-commodities accounts currency)) (entries 0)) 286 (match comm-list 287 (() 288 (unless (zero? entries) 289 (gnc:html-table-set-col-headers! 290 table (list (gnc:make-html-table-header-cell/size 291 1 2 (NG_ "Exchange rate" "Exchange rates" entries))))) 292 table) 293 ((comm . rest) 294 (gnc:html-table-append-row! 295 table 296 (list (cell (gnc:make-gnc-monetary comm 1)) 297 (cell (gnc:default-price-renderer currency (price-fn comm))))) 298 (lp rest (1+ entries)))))) 299 300 301(define (gnc:html-make-generic-budget-warning report-title-string) 302 (gnc:html-make-generic-simple-warning 303 report-title-string 304 (G_ "No budgets exist. You must create at least one budget."))) 305 306 307(define (gnc:html-make-generic-simple-warning report-title-string message) 308 (gnc:make-html-text 309 (gnc:html-markup-h3 (string-append report-title-string ":")) 310 (gnc:html-markup-h3 "") 311 (gnc:html-markup-p message))) 312 313 314(define (gnc:html-make-options-link report-id) 315 (if report-id 316 (gnc:html-markup-p 317 (gnc:html-markup-anchor 318 (gnc-build-url URL-TYPE-OPTIONS 319 (string-append "report-id=" (format #f "~a" report-id)) 320 "") 321 (G_ "Edit report options"))))) 322 323(define* (gnc:html-render-options-changed options #:optional plaintext?) 324 ;; options -> html-object or string, depending on plaintext?. This 325 ;; summarises options that were changed by the user. Set plaintext? 326 ;; to #t for unit-tests only. 327 (define (disp d) 328 ;; option-value -> string. The option is passed to various 329 ;; scm->string converters; ultimately a generic stringify 330 ;; function handles symbol/string/other types. 331 (define (try proc) 332 ;; Try proc with d as a parameter, catching 'wrong-type-arg 333 ;; exceptions to return #f to the or evaluator. 334 (catch 'wrong-type-arg 335 (lambda () (proc d)) 336 (const #f))) 337 (or (and (boolean? d) (if d (G_ "Enabled") (G_ "Disabled"))) 338 (and (null? d) "null") 339 (and (list? d) (string-join (map disp d) ", ")) 340 (and (pair? d) (format #f "~a . ~a" 341 (car d) 342 (if (eq? (car d) 'absolute) 343 (qof-print-date (cdr d)) 344 (disp (cdr d))))) 345 (try gnc-commodity-get-mnemonic) 346 (try xaccAccountGetName) 347 (try gnc-budget-get-name) 348 (format #f "~a" d))) 349 (let ((render-list '()) 350 (report-list (and=> (gnc:lookup-option options "__general" "report-list") 351 gnc:option-value))) 352 (define (add-option-if-changed option) 353 (let* ((section (gnc:option-section option)) 354 (name (gnc:option-name option)) 355 (default-value (gnc:option-default-value option)) 356 (value (gnc:option-value option)) 357 (retval (cons (format #f "~a / ~a" section name) 358 (disp value)))) 359 (if (not (or (equal? default-value value) 360 (char=? (string-ref section 0) #\_))) 361 (addto! render-list retval)))) 362 (define (name-fn name) (if plaintext? name (gnc:html-markup-b name))) 363 (define br (if plaintext? "\n" (gnc:html-markup-br))) 364 (for-each 365 (lambda (child) 366 (let ((report (gnc-report-find (car child)))) 367 (addto! render-list (cons "Embedded Report" (gnc:report-name report))))) 368 (or report-list '())) 369 (gnc:options-for-each add-option-if-changed options) 370 (let lp ((render-list (reverse render-list)) (acc '())) 371 (match render-list 372 (() (if plaintext? (string-concatenate acc) (apply gnc:make-html-text acc))) 373 (((name . val) . rest) (lp rest (cons* (name-fn name) ": " val br acc))))))) 374 375(define (gnc:html-make-generic-warning 376 report-title-string report-id 377 warning-title-string warning-string) 378 (gnc:make-html-text 379 (gnc:html-markup-h3 (string-append (G_ report-title-string) ":")) 380 (gnc:html-markup-h3 warning-title-string) 381 (gnc:html-markup-p warning-string) 382 (gnc:html-make-options-link report-id))) 383 384(define (gnc:html-make-generic-options-warning 385 report-title-string report-id) 386 (gnc:html-make-generic-warning 387 report-title-string 388 report-id 389 "" 390 (G_ "This report requires you to specify certain report options."))) 391 392(define (gnc:html-make-no-account-warning 393 report-title-string report-id) 394 (gnc:html-make-generic-warning 395 report-title-string 396 report-id 397 (G_ "No accounts selected") 398 (G_ "This report requires accounts to be selected in the report options."))) 399 400(define (gnc:html-make-empty-data-warning 401 report-title-string report-id) 402 (gnc:html-make-generic-warning 403 report-title-string 404 report-id 405 (G_ "No data") 406 (G_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period"))) 407 408(define (gnc:html-js-include file) 409 (format #f 410 "<script language=\"javascript\" type=\"text/javascript\" src=\"file:///~a\"></script>\n" 411 (gnc-path-find-localized-html-file file))) 412 413(define (gnc:html-css-include file) 414 (format #f 415 "<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///~a\" />\n" 416 (gnc-path-find-localized-html-file file))) 417 418 419 420