1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2;; report-impl.scm : structures/utilities for representing reports 3;; Copyright 2000 Bill Gribble <grib@gnumatic.com> 4;; 5;; This program is free software; you can redistribute it and/or 6;; modify it under the terms of the GNU General Public License as 7;; published by the Free Software Foundation; either version 2 of 8;; the License, or (at your option) any later version. 9;; 10;; This program is distributed in the hope that it will be useful, 11;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13;; GNU General Public License for more details. 14;; 15;; You should have received a copy of the GNU General Public License 16;; along with this program; if not, contact: 17;; 18;; Free Software Foundation Voice: +1-617-542-5942 19;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 20;; Boston, MA 02110-1301, USA gnu@gnu.org 21;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22(define-module (gnucash report report-core)) 23 24(eval-when (compile load eval expand) 25 (load-extension "libgnc-report" "scm_init_sw_report_module")) 26 27(use-modules (gnucash engine)) 28(use-modules (gnucash utilities)) 29(use-modules (gnucash app-utils)) 30(use-modules (gnucash core-utils)) 31(use-modules (gnucash gnome-utils)) 32(use-modules (ice-9 match)) 33(use-modules (srfi srfi-1)) 34(use-modules (srfi srfi-9)) 35(use-modules (srfi srfi-26)) 36(use-modules (gnucash report report-register-hooks)) 37(use-modules (gnucash report html-style-sheet)) 38(use-modules (gnucash report html-document)) 39(use-modules (gnucash report html-utilities)) 40 41(load-and-reexport (sw_report) 42 (sw_engine)) 43 44(export <report>) 45(export gnc:all-report-template-guids) 46(export gnc:custom-report-template-guids) 47(export gnc:define-report) 48(export gnc:delete-report) 49(export gnc:find-report-template) 50(export gnc:is-custom-report-type) 51(export gnc:make-report) 52(export gnc:make-report-options) 53(export gnc:menuname-asset-liability) 54(export gnc:menuname-budget) 55(export gnc:menuname-business-reports) 56(export gnc:menuname-custom) 57(export gnc:menuname-example) 58(export gnc:menuname-experimental) 59(export gnc:menuname-income-expense) 60(export gnc:menuname-multicolumn) 61(export gnc:menuname-reports) 62(export gnc:menuname-taxes) 63(export gnc:optname-invoice-number) 64(export gnc:optname-reportname) 65(export gnc:pagename-accounts) 66(export gnc:pagename-display) 67(export gnc:pagename-general) 68(export gnc:rename-report) 69(export gnc:report-ctext) 70(export gnc:report-dirty?) 71(export gnc:report-editor-widget) 72(export gnc:report-embedded-list) 73(export gnc:report-export-thunk) 74(export gnc:report-export-types) 75(export gnc:report-id) 76(export gnc:report-menu-name) 77(export gnc:report-name) 78(export gnc:report-needs-save?) 79(export gnc:report-options) 80(export gnc:report-render-html) 81(export gnc:render-report) 82(export gnc:report-run) 83(export gnc:report-serialize) 84(export gnc:report-set-ctext!) 85(export gnc:report-set-dirty?!) 86(export gnc:report-set-editor-widget!) 87(export gnc:report-set-id!) 88(export gnc:report-set-needs-save?!) 89(export gnc:report-set-options!) 90(export gnc:report-set-stylesheet!) 91(export gnc:report-set-type!) 92(export gnc:report-stylesheet) 93(export gnc:report-template-export-thunk) 94(export gnc:report-template-export-types) 95(export gnc:report-template-has-unique-name?) 96(export gnc:report-template-in-menu?) 97(export gnc:report-template-is-custom/template-guid?) 98(export gnc:report-template-menu-name) 99(export gnc:report-template-menu-name/report-guid) 100(export gnc:report-template-menu-path) 101(export gnc:report-template-menu-tip) 102(export gnc:report-template-name) 103(export gnc:report-template-new-options) 104(export gnc:report-template-new-options/report-guid) 105(export gnc:report-template-options-changed-cb) 106(export gnc:report-template-options-cleanup-cb) 107(export gnc:report-template-options-generator) 108(export gnc:report-template-renderer) 109(export gnc:report-template-renderer/report-guid) 110(export gnc:report-template-report-guid) 111(export gnc:report-template-set-report-guid!) 112(export gnc:report-template-version) 113(export gnc:report-templates-for-each) 114(export gnc:report-to-template-new) 115(export gnc:report-to-template-update) 116(export gnc:report-type) 117(export gnc:restore-report-by-guid) 118(export gnc:restore-report-by-guid-with-custom-template) 119 120;; Terminology in this file: 121;; report-template: a report definition of some form. This can be a report 122;; included in gnucash by default, or a new report definition added by 123;; the user in the .gnucash directory or a custom report 124;; custom report: like a report-template, but saved with a different set 125;; of default options. A better name would probably be "preconfigured 126;; report" or something similar. These templates are managed by the 127;; user via the "Preconfigured Reports" menu item 128;; report: an instantiation of a report-template (custom or otherwise). One 129;; specific instance of a template, loaded and configured by the user 130;; while the program is running. 131;; saved report: a report that was still open at the time a book is closed. 132;; GnuCash dumps the current settings and template id for such a report 133;; in a meta file in .gnucash/books. When the book is reopened, the template 134;; id and settings are used to restore the report to the state it was 135;; in before the book was closed. 136;; 137;; This file will define record types for report-templates and reports. From what 138;; I understand the latter is used mostly to handle saved reports as defined above, 139;; while the former manages report-templates (including custom-reports). 140 141;; This hash should contain all the reports available and will be used 142;; to generate the reports menu whenever a new window opens and to 143;; figure out what to do when a report needs to be generated. 144;; 145;; The key is the report guid and the 146;; value is the report definition structure. 147(define *gnc:_report-templates_* (make-hash-table 23)) 148 149;; Define those strings here to make changes easier and avoid typos. 150(define gnc:menuname-reports "Reports/StandardReports") 151(define gnc:menuname-asset-liability (N_ "_Assets & Liabilities")) 152(define gnc:menuname-income-expense (N_ "_Income & Expense")) 153(define gnc:menuname-budget (N_ "B_udget")) 154(define gnc:menuname-taxes (N_ "_Taxes")) 155(define gnc:menuname-example (N_ "E_xamples")) 156(define gnc:menuname-experimental (N_ "_Experimental")) 157(define gnc:menuname-multicolumn (N_ "_Multicolumn")) 158(define gnc:menuname-custom (N_ "_Custom")) 159(define gnc:pagename-general (N_ "General")) 160(define gnc:pagename-accounts (N_ "Accounts")) 161(define gnc:pagename-display (N_ "Display")) 162(define gnc:optname-reportname (N_ "Report name")) 163(define gnc:optname-stylesheet (N_ "Stylesheet")) 164(define gnc:menuname-business-reports (N_ "_Business")) 165(define gnc:optname-invoice-number (N_ "Invoice Number")) 166 167;; A <report-template> represents one of the available report types. 168(define-record-type <report-template> 169 (make-new-record-template version name report-guid parent-type options-generator 170 options-cleanup-cb options-changed-cb 171 renderer in-menu? menu-path menu-name 172 menu-tip export-types export-thunk) 173 report-template? 174 (version report-template-version) 175 (report-guid report-template-report-guid report-template-set-report-guid!) 176 (name report-template-name report-template-set-name) 177 (parent-type report-template-parent-type report-template-set-parent-type!) 178 (options-generator report-template-options-generator) 179 (options-cleanup-cb report-template-options-cleanup-cb) 180 (options-changed-cb report-template-options-changed-cb) 181 (renderer report-template-renderer) 182 (in-menu? report-template-in-menu?) 183 (menu-path report-template-menu-path) 184 (menu-name report-template-menu-name) 185 (menu-tip report-template-menu-tip) 186 (export-types report-template-export-types) 187 (export-thunk report-template-export-thunk)) 188 189(define (make-report-template) 190 (make-new-record-template #f #f #f #f #f #f #f #f #t #f #f #f #f #f)) 191(define gnc:report-template-version report-template-version) 192(define gnc:report-template-report-guid report-template-report-guid) 193(define gnc:report-template-set-report-guid! report-template-set-report-guid!) 194(define gnc:report-template-name report-template-name) 195(define gnc:report-template-set-name report-template-set-name) 196(define gnc:report-template-parent-type report-template-parent-type) 197(define gnc:report-template-set-parent-type! report-template-set-parent-type!) 198(define gnc:report-template-options-generator report-template-options-generator) 199(define gnc:report-template-options-cleanup-cb report-template-options-cleanup-cb) 200(define gnc:report-template-options-changed-cb report-template-options-changed-cb) 201(define gnc:report-template-renderer report-template-renderer) 202(define gnc:report-template-in-menu? report-template-in-menu?) 203(define gnc:report-template-menu-path report-template-menu-path) 204(define gnc:report-template-menu-name report-template-menu-name) 205(define gnc:report-template-menu-tip report-template-menu-tip) 206(define gnc:report-template-export-types report-template-export-types) 207(define gnc:report-template-export-thunk report-template-export-thunk) 208 209;; define strings centrally to ease code clarity 210(define rpterr-dupe 211 (G_ "One of your reports has a report-guid that is a duplicate. Please check the report system, especially your saved reports, for a report with this report-guid: ")) 212(define rpterr-guid1 (G_ "Wrong report definition: ")) 213(define rpterr-guid2 (G_ " Report is missing a GUID.")) 214 215(define (gui-error str) 216 (if (gnucash-ui-is-running) 217 (gnc-error-dialog '() str) 218 (gnc:error "report-core.scm error: " str))) 219(define (gui-warning str) 220 (if (gnucash-ui-is-running) 221 (gnc-warning-dialog '() str) 222 (gnc:warn "report-core.scm warning: " str))) 223(define (gui-error-missing-template template-name) 224 (gui-error 225 (string-append 226 "Report Failed! One of your previously opened reports has failed \ 227to open. The template on which it was based: " template-name ", was \ 228not found."))) 229 230;; if args is supplied, it is a list of field names and values 231(define (gnc:define-report . args) 232 ;; For now the version is ignored, but in the future it'll let us 233 ;; change behaviors without breaking older reports. 234 ;; 235 ;; The renderer should be a function that accepts one argument, a 236 ;; set of options, and generates the report. the renderer must 237 ;; return as its final value an <html-document> object. 238 (define report-rec (make-report-template)) 239 (define allowable-fields (record-type-fields <report-template>)) 240 (define (not-a-field? fld) (not (memq fld allowable-fields))) 241 (define (xor . args) (fold (lambda (a b) (if a (if b #f a) b)) #f args)) 242 243 (let loop ((args args)) 244 (match args 245 (() 246 (let ((report-guid (gnc:report-template-report-guid report-rec)) 247 (report-name (gnc:report-template-name report-rec))) 248 (cond 249 ;; missing report-guid: is an error 250 ((not report-guid) 251 (gui-error (string-append rpterr-guid1 report-name rpterr-guid2))) 252 253 ;; dupe: report-guid is a duplicate 254 ((hash-ref *gnc:_report-templates_* report-guid) 255 (gui-error (string-append rpterr-dupe report-guid))) 256 257 ;; has export-type but no export-thunk. or vice versa. 258 ((xor (gnc:report-template-export-thunk report-rec) 259 (gnc:report-template-export-types report-rec)) 260 (gui-error (format #f "Export needs both thunk and types: ~a" report-guid))) 261 262 ;; good: new report definition, store into report-templates hash 263 (else 264 (hash-set! *gnc:_report-templates_* report-guid report-rec))))) 265 266 (((? not-a-field? fld) . _) 267 (gnc:error "gnc:define-report: " fld " is not a valid field")) 268 269 ((field val . rest) 270 ((record-modifier <report-template> field) report-rec val) 271 (loop rest))))) 272 273(define (gnc:report-template-new-options/report-guid template-id template-name) 274 (let ((templ (hash-ref *gnc:_report-templates_* template-id))) 275 (and templ 276 (gnc:report-template-new-options templ)))) 277 278(define (gnc:report-template-menu-name/report-guid template-id template-name) 279 (let ((templ (hash-ref *gnc:_report-templates_* template-id))) 280 (and templ 281 (or (gnc:report-template-menu-name templ) 282 (gnc:report-template-name templ))))) 283 284(define (gnc:report-template-renderer/report-guid template-id template-name) 285 (let ((templ (hash-ref *gnc:_report-templates_* template-id))) 286 (and templ 287 (gnc:report-template-renderer templ)))) 288 289(define (gnc:report-template-new-options report-template) 290 (let ((generator (gnc:report-template-options-generator report-template)) 291 (namer 292 (gnc:make-string-option 293 gnc:pagename-general gnc:optname-reportname "0a" 294 (N_ "Enter a descriptive name for this report.") 295 (G_ (gnc:report-template-name report-template)))) 296 (stylesheet 297 (gnc:make-multichoice-option 298 gnc:pagename-general gnc:optname-stylesheet "0b" 299 (N_ "Select a stylesheet for the report.") 300 (string->symbol (N_ "Default")) 301 (map 302 (lambda (ss) 303 (vector 304 (string->symbol (gnc:html-style-sheet-name ss)) 305 (gnc:html-style-sheet-name ss))) 306 (gnc:get-html-style-sheets))))) 307 308 (let ((options (if (procedure? generator) 309 (or (gnc:backtrace-if-exception generator) 310 (begin 311 (gnc:warn "BUG DETECTED: Scheme exception raised in " 312 "report options generator procedure named " 313 (procedure-name generator)) 314 (gnc:new-options))) 315 (gnc:new-options)))) 316 (or (gnc:lookup-option options gnc:pagename-general gnc:optname-reportname) 317 (gnc:register-option options namer)) 318 (or (gnc:lookup-option options gnc:pagename-general gnc:optname-stylesheet) 319 (gnc:register-option options stylesheet)) 320 options))) 321 322;; A <report> represents an instantiation of a particular report type. 323(define-record-type <report> 324 (make-report type id options dirty? needs-save? editor-widget ctext custom-template) 325 report? 326 (type report-type report-set-type!) 327 (id report-id report-set-id!) 328 (options report-options report-set-options!) 329 (dirty? report-dirty? report-set-dirty?!) 330 (needs-save? report-needs-save? report-set-needs-save?!) 331 (editor-widget report-editor-widget report-set-editor-widget!) 332 (ctext report-ctext report-set-ctext!) 333 (custom-template report-custom-template report-set-custom-template!)) 334 335(define gnc:report-type report-type) 336(define gnc:report-set-type! report-set-type!) 337(define gnc:report-id report-id) 338(define gnc:report-set-id! report-set-id!) 339(define gnc:report-options report-options) 340(define gnc:report-set-options! report-set-options!) 341(define gnc:report-needs-save? report-needs-save?) 342(define gnc:report-set-needs-save?! report-set-needs-save?!) 343(define gnc:report-dirty? report-dirty?) 344(define gnc:report-set-dirty?-internal! report-set-dirty?!) 345(define gnc:report-editor-widget report-editor-widget) 346(define gnc:report-set-editor-widget! report-set-editor-widget!) 347(define gnc:report-ctext report-ctext) 348(define gnc:report-set-ctext! report-set-ctext!) 349(define gnc:report-custom-template report-custom-template) 350(define gnc:report-set-custom-template! report-set-custom-template!) 351 352(define (gnc:report-set-dirty?! report val) 353 (gnc:report-set-dirty?-internal! report val) 354 (let* ((template (hash-ref *gnc:_report-templates_* (gnc:report-type report))) 355 (cb (gnc:report-template-options-changed-cb template))) 356 (if (and cb (procedure? cb)) 357 (cb report)))) 358 359;; gnc:make-report instantiates a report from a report-template. 360;; The actual report is stored away in a hash-table -- only the id is returned. 361(define (gnc:make-report template-id . rest) 362 (let* ((template-parent (gnc:report-template-parent-type 363 (hash-ref *gnc:_report-templates_* template-id))) 364 (report-type (or template-parent template-id)) 365 (custom-template (if template-parent template-id "")) 366 (r (make-report 367 report-type ;; type 368 #f ;; id 369 #f ;; options 370 #t ;; dirty 371 #f ;; needs-save 372 #f ;; editor-widget 373 #f ;; ctext 374 custom-template ;; custom-template 375 )) 376 (template (hash-ref *gnc:_report-templates_* template-id))) 377 (let ((options (if (null? rest) 378 (gnc:report-template-new-options template) 379 (car rest)))) 380 (gnc:report-set-options! r options) 381 (gnc:options-register-callback 382 #f #f 383 (lambda () 384 (gnc:report-set-dirty?! r #t) 385 (let ((cb (gnc:report-template-options-changed-cb template))) 386 (if cb (cb r)))) 387 options)) 388 (gnc:report-set-id! r (gnc-report-add r)) 389 (gnc:report-id r))) 390 391 392(define (gnc:restore-report-by-guid id template-id template-name options) 393 (issue-deprecation-warning "gnc:restore-report-by-guid is now deprecated. 394 use gnc:restore-report-by-guid-with-custom-template instead.") 395 (if options 396 (let* ((r (make-report template-id id options #t #t #f #f "")) 397 (report-id (gnc-report-add r))) 398 (if (number? report-id) 399 (gnc:report-set-id! r report-id)) 400 report-id) 401 (begin 402 (gui-error-missing-template template-name) 403 #f))) 404 405(define (gnc:restore-report-by-guid-with-custom-template 406 id template-id template-name custom-template-id options) 407 (if options 408 (let* ((r (make-report template-id id options #t #t #f #f custom-template-id)) 409 (report-id (gnc-report-add r))) 410 (if (number? report-id) 411 (gnc:report-set-id! r report-id)) 412 report-id) 413 (begin 414 (gui-error-missing-template template-name) 415 #f))) 416 417(define (gnc:make-report-options template-id) 418 (let ((template (hash-ref *gnc:_report-templates_* template-id))) 419 (and template 420 (gnc:report-template-new-options template)))) 421 422;; A convenience wrapper to get the report-template's export types from 423;; an instantiated report. 424(define (gnc:report-export-types report) 425 (let ((template (hash-ref *gnc:_report-templates_* 426 (gnc:report-type report)))) 427 (and template 428 (gnc:report-template-export-types template)))) 429 430;; A convenience wrapper to get the report-template's export thunk from 431;; an instantiated report. 432(define (gnc:report-export-thunk report) 433 (let ((template (hash-ref *gnc:_report-templates_* 434 (gnc:report-type report)))) 435 (and template 436 (gnc:report-template-export-thunk template)))) 437 438(define (gnc:report-menu-name report) 439 (let ((template (hash-ref *gnc:_report-templates_* 440 (gnc:report-type report)))) 441 (and template 442 (or (gnc:report-template-menu-name template) 443 (gnc:report-name report))))) 444 445(define (gnc:report-name report) 446 (let* ((opt (gnc:report-options report))) 447 (and opt 448 (gnc:option-value 449 (gnc:lookup-option opt gnc:pagename-general gnc:optname-reportname))))) 450 451(define (gnc:report-stylesheet report) 452 (gnc:html-style-sheet-find 453 (symbol->string (gnc:option-value 454 (gnc:lookup-option 455 (gnc:report-options report) 456 gnc:pagename-general 457 gnc:optname-stylesheet))))) 458 459(define (gnc:report-set-stylesheet! report stylesheet) 460 (gnc:option-set-value 461 (gnc:lookup-option 462 (gnc:report-options report) 463 gnc:pagename-general 464 gnc:optname-stylesheet) 465 (string->symbol 466 (gnc:html-style-sheet-name stylesheet)))) 467 468 469;; Load and save helper functions 470 471;; list of all report guids in existence (includes standard & custom 472;; reports, but not instantiated ones) 473(define (gnc:all-report-template-guids) 474 (map car (hash-map->list cons *gnc:_report-templates_*))) 475 476;; return a list of the custom report template guids. 477(define (gnc:custom-report-template-guids) 478 (map car (gnc:custom-report-templates-list))) 479 480(define (gnc:find-report-template guid) 481 (hash-ref *gnc:_report-templates_* guid)) 482 483(define (gnc:report-template-is-custom/template-guid? guid) 484 (assoc guid (gnc:custom-report-templates-list))) 485 486(define (gnc:is-custom-report-type report) 487 (gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report))) 488 489;; list of reports saved within the saved-reports; returns a list of 490;; pairs whose cars = guid <string> and cdrs = report-template <record> 491(define (gnc:custom-report-templates-list) 492 (filter (compose gnc:report-template-parent-type cdr) 493 (hash-map->list cons *gnc:_report-templates_*))) 494 495;; This function should be called right before changing a custom-template's name 496;; to test if the new name is unique among the existting custom reports. 497;; If not the calling function can prevent the name from being updated. 498(define (gnc:report-template-has-unique-name? templ-guid new-name) 499 (or (not new-name) 500 (not (any 501 (lambda (tmpl) 502 (and (not (equal? (car tmpl) templ-guid)) 503 (equal? (gnc:report-template-name (cdr tmpl)) new-name))) 504 (gnc:custom-report-templates-list))))) 505 506;; Generate a unique custom template name using the given string as a base 507;; If this string already exists as a custom template name, a 508;; number will be appended to it. 509(define (gnc:report-template-make-unique-name new-name) 510 (let loop ((name new-name) 511 (counter 1)) 512 (if (gnc:report-template-has-unique-name? #f name) 513 name 514 (loop (string-append new-name (number->string counter)) 515 (1+ counter))))) 516 517 518;; Load and save functions 519 520 521;; Generate guile code required to recreate an instatiated report 522(define (gnc:report-serialize report) 523 ;; clean up the options if necessary. this is only needed 524 ;; in special cases. 525 (let* ((report-type (gnc:report-type report)) 526 (template (hash-ref *gnc:_report-templates_* report-type)) 527 (thunk (gnc:report-template-options-cleanup-cb template))) 528 (if thunk 529 (thunk report))) 530 531 ;; save them 532 (string-append 533 ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" 534 (format #f ";; options for report ~S\n" (gnc:report-name report)) 535 (format 536 #f "(let ((options (gnc:report-template-new-options/report-guid ~S ~S)))\n" 537 (gnc:report-type report) 538 (gnc:report-template-name 539 (hash-ref *gnc:_report-templates_* (gnc:report-type report)))) 540 (gnc:generate-restore-forms (gnc:report-options report) "options") 541 (format 542 #f " (gnc:restore-report-by-guid-with-custom-template ~S ~S ~S ~S options)\n" 543 (gnc:report-id report) (gnc:report-type report) 544 (gnc:report-template-name 545 (hash-ref *gnc:_report-templates_* (gnc:report-type report))) 546 (gnc:report-custom-template report)) 547 ")")) 548 549;; Generate guile code required to recreate embedded report instances 550(define (gnc:report-serialize-embedded embedded-reports) 551 (let* ((result-string "")) 552 (if embedded-reports 553 (begin 554 (for-each 555 (lambda (subreport-id) 556 (let* ((subreport (gnc-report-find subreport-id)) 557 (subreport-type (gnc:report-type subreport)) 558 (subreport-template (hash-ref *gnc:_report-templates_* subreport-type)) 559 (subreport-template-name (gnc:report-template-name subreport-template)) 560 (thunk (gnc:report-template-options-cleanup-cb subreport-template))) 561 ;; clean up the options if necessary. this is only needed 562 ;; in special cases. 563 (if thunk 564 (thunk subreport)) 565 ;; save them 566 (set! result-string 567 (string-append 568 result-string 569 "\n ;;;; Options for embedded report\n" 570 " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" 571 (format #f " ;; options for report ~S\n" (gnc:report-name subreport)) 572 (format #f " (let ((options (gnc:report-template-new-options/report-guid ~S ~S)))" 573 subreport-type 574 subreport-template-name) 575 (gnc:generate-restore-forms (gnc:report-options subreport) "options") 576 (format #f "\n (set! new-embedded-report-ids\n (append\n new-embedded-report-ids\n (list (gnc:restore-report-by-guid-with-custom-template #f ~S ~S ~S options))\n )\n )\n" 577 subreport-type 578 subreport-template-name 579 (gnc:report-custom-template subreport)) 580 " )\n")))) 581 embedded-reports) 582 ;;(set! result-string (string-append result-string (gnc:update-section-general))) 583 (set! result-string 584 (string-append 585 result-string 586 "\n" 587 " ;;;; Update Section: __general\n" 588 " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" 589 " (let*\n" 590 " (\n" 591 " (option (gnc:lookup-option options \"__general\" \"report-list\"))\n" 592 " (saved-report-list (gnc:option-value option))\n" 593 " )\n" 594 " (\n" 595 " (lambda (option)\n" 596 " (if option ((gnc:option-setter option) (map (lambda (x y) (cons x (cdr y))) new-embedded-report-ids saved-report-list)))\n" 597 " )\n" 598 " option\n" 599 " )\n" 600 " )\n")))) 601 result-string)) 602 603(define (gnc:report-template-serialize-internal name type templ-name options guid) 604 (let* ((embedded-serialized (gnc:report-serialize-embedded (gnc:report-embedded-list options))) 605 (result (string-append 606 ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" 607 (format #f ";; Options for saved report ~S, based on template ~S\n" 608 name type) 609 (format 610 #f "(let ()\n (define (options-gen)\n (let\n (\n (options (gnc:report-template-new-options/report-guid ~S ~S))\n (new-embedded-report-ids '()) ;; only used with Multicolumn View Reports\n )" 611 type templ-name) 612 (gnc:generate-restore-forms options "options") 613 (if embedded-serialized 614 embedded-serialized 615 "") 616 "\n options\n )\n )\n" 617 (format 618 #f " (gnc:define-report \n 'version 1\n 'name ~S\n 'report-guid ~S\n 'parent-type ~S\n 'options-generator options-gen\n 'menu-path (list gnc:menuname-custom)\n 'renderer (gnc:report-template-renderer/report-guid ~S ~S)\n )\n)\n\n" 619 name 620 (or guid 621 (guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading 622 type 623 type 624 templ-name)))) 625 (gnc:debug result) 626 result)) 627 628;; Convert an instantiated report into a report template 629;; and generate the guile code required to recreate this template 630(define (gnc:report-template-serialize-from-report report) 631 ;; clean up the options if necessary. this is only needed 632 ;; in special cases. 633 (let* ((template (hash-ref *gnc:_report-templates_* (gnc:report-type report))) 634 (thunk (gnc:report-template-options-cleanup-cb template))) 635 (if thunk 636 (thunk report))) 637 638 ;; save them 639 (let* ((name (gnc:report-template-make-unique-name (gnc:report-name report))) 640 (type (gnc:report-type report)) 641 (templ-name (gnc:report-template-name 642 (hash-ref *gnc:_report-templates_* (gnc:report-type report)))) 643 (options (gnc:report-options report))) 644 (gnc:report-template-serialize-internal name type templ-name options #f))) 645 646;; Generate guile code required to recreate a report template 647;; Note: multi column report templates encapsulate instantiated 648;; reports, not other report templates this means that the template 649;; recreation code must also contain the code to instantiate these 650;; embedded report instances. This results in a mix of template and 651;; instatiated reports in the saved reports file... 652(define (gnc:report-template-serialize report-template) 653 (let* ((name (gnc:report-template-name report-template)) 654 (type (gnc:report-template-parent-type report-template)) 655 (templ-name (gnc:report-template-name 656 (hash-ref *gnc:_report-templates_* type))) 657 (options (gnc:report-template-new-options report-template)) 658 (guid (gnc:report-template-report-guid report-template))) 659 (gnc:report-template-serialize-internal name type templ-name options guid))) 660 661;; Convert a report into a report template and save this template in the savefile 662;; Under specific conditions the we will attempt to replace the current report's 663;; template instead of simply adding a new template to the file. 664;; These condititions are: 665;; 1. the report is an instance of an existing custom report template 666;; (ie a template that is stored in the savefile already) 667;; 2. an overwrite is requested by setting overwrite? to #t 668(define (gnc:report-to-template report overwrite?) 669 ;; This implements the Save Report Configuration tasks 670 (let* ((custom-template-id (gnc:report-custom-template report)) 671 (overwrite-ok? (and (gnc:report-template-is-custom/template-guid? 672 custom-template-id) 673 overwrite?)) 674 ;; Generate a serialized report-template with a random guid 675 (saved-form (gnc:report-template-serialize-from-report report)) 676 ;; Immediately evaluate the serialized report template to 677 ;; - check if it's error free and can be deserialized 678 ;; - load it into the runtime for immediate use by the user 679 ;; (Bug #342206) 680 (save-result (eval-string saved-form))) 681 682 (and (record? save-result) 683 (begin 684 ;; If it's ok to overwrite the old template, delete it now. 685 (if overwrite-ok? 686 (let ((templ-name 687 (gnc:report-template-name 688 (hash-ref *gnc:_report-templates_* custom-template-id)))) 689 ;; We're overwriting, which needs some additional steps 690 ;; 1. Remove the newly generated template from the template list again 691 (hash-remove! *gnc:_report-templates_* 692 (gnc:report-template-report-guid save-result)) 693 ;; 2. We still have the template record available 694 ;; though, so adapt it to the template we want to 695 ;; override (ie update guid and name) 696 (gnc:report-template-set-report-guid! save-result custom-template-id) 697 (gnc:report-template-set-name save-result templ-name) 698 ;; 3. Overwrite the template with the new one 699 (hash-set! *gnc:_report-templates_* custom-template-id save-result))) 700 701 ;; Regardless of how we got here, we now have a new template to write 702 ;; so let's write it 703 (and (gnc:save-all-reports) 704 (let ((templ-guid (gnc:report-template-report-guid save-result))) 705 ;; Indicate the report was instantiated from the new template 706 (gnc:report-set-custom-template! report templ-guid) 707 ;; Inform the calling function of the new template's guid 708 templ-guid)))))) 709 710;; Convert a report into a new report template and add this template to the save file 711(define (gnc:report-to-template-new report) 712 (gnc:report-to-template report #f)) 713 714;; Get the current report's template and try to update it with the report's current 715;; settings. This will only be possible if the report was already based on a 716;; custom report template. If that's not the case, a new template will be added instead. 717(define (gnc:report-to-template-update report) 718 (gnc:report-to-template report #t)) 719 720(define (gnc:report-template-save-to-savefile report-template) 721 (let ((saved-form (gnc:report-template-serialize report-template))) 722 (gnc-saved-reports-write-to-file saved-form #f))) 723 724;; save all custom reports, moving the old version of the 725;; saved-reports file aside as a backup 726;; return #t if all templates were saved successfully 727(define (gnc:save-all-reports) 728 (gnc-saved-reports-backup) 729 (gnc-saved-reports-write-to-file "" #t) 730 (every identity 731 (map 732 (lambda (p) 733 (gnc:debug "saving report " (car p)) 734 (gnc:report-template-save-to-savefile (cdr p))) 735 (gnc:custom-report-templates-list)))) 736 737 738;; gets the renderer from the report template; 739;; gets the stylesheet from the report; 740;; renders the html doc and caches the resulting string; 741;; returns the html string. 742;; Now accepts either an html-doc or finished HTML from the renderer - 743;; the former requires further processing, the latter is just returned. 744(define (gnc:report-render-html report headers?) 745 (if (and (not (gnc:report-dirty? report)) 746 (gnc:report-ctext report)) 747 (gnc:report-ctext report) 748 (let ((template (hash-ref *gnc:_report-templates_* (gnc:report-type report)))) 749 (and template 750 (let* ((renderer (gnc:report-template-renderer template)) 751 (stylesheet (gnc:report-stylesheet report)) 752 (doc (renderer report)) 753 (html (cond 754 ((string? doc) doc) 755 (else 756 (gnc:html-document-set-style-sheet! doc stylesheet) 757 (gnc:html-document-render doc headers?))))) 758 (gnc:report-set-ctext! report html) ;; cache the html 759 (gnc:report-set-dirty?! report #f) ;; mark it clean 760 html))))) 761 762;; render report. will return a 2-element list: either (list html #f) 763;; where html is the report html string, or (list #f captured-error) 764;; where captured-error is the error string. 765(define (gnc:render-report report) 766 (define (get-report) (gnc:report-render-html report #t)) 767 (gnc:apply-with-error-handling get-report '())) 768 769;; looks up the report by id and renders it with gnc:report-render-html 770;; marks the cursor busy during rendering; returns the html 771(define (gnc:report-run id) 772 (issue-deprecation-warning "gnc:report-run is deprecated. use gnc:render-report instead.") 773 (let ((report (gnc-report-find id)) 774 (html #f)) 775 (gnc-set-busy-cursor '() #t) 776 (gnc:backtrace-if-exception 777 (lambda () 778 (if report (set! html (gnc:report-render-html report #t))))) 779 (gnc-unset-busy-cursor '()) 780 html)) 781 782 783;; "thunk" should take the report-type and the report template record 784(define (gnc:report-templates-for-each thunk) 785 (hash-for-each 786 (lambda (report-id template) 787 (thunk report-id template)) 788 *gnc:_report-templates_*)) 789 790;; return the list of reports embedded in the specified report 791(define (gnc:report-embedded-list options) 792 (let* ((option (gnc:lookup-option options "__general" "report-list"))) 793 (and option 794 (let ((opt-value (gnc:option-value option))) 795 (map car opt-value))))) 796 797;; delete an existing report from the hash table and then call to 798;; resave the saved-reports file... report is gone 799(define (gnc:delete-report template-guid) 800 (if (hash-ref *gnc:_report-templates_* template-guid) 801 (begin 802 (gnc:debug "Deleting report " template-guid) 803 (hash-remove! *gnc:_report-templates_* template-guid) 804 (gnc:save-all-reports)))) 805 806;; rename an existing report from the hash table and then 807;; resave the saved-reports file 808(define (gnc:rename-report template-guid new-name) 809 (let ((templ (hash-ref *gnc:_report-templates_* template-guid))) 810 (when templ 811 (gnc:debug "Renaming report " template-guid) 812 (gnc:report-template-set-name templ new-name) 813 (gnc:save-all-reports)))) 814 815;; 816;; gnucash-cli helper and exported functions 817;; 818 819(define (show-selected-reports pred? port) 820 (for-each 821 (lambda (template) 822 (format port "* ~a ~a\n" 823 (if (gnc:report-template-parent-type template) "C" " ") 824 (gnc:report-template-name template))) 825 (sort (hash-fold (lambda (k v p) (if (pred? v) (cons v p) p)) '() 826 *gnc:_report-templates_*) 827 (lambda (a b) (gnc:string-locale<? (gnc:report-template-name a) 828 (gnc:report-template-name b)))))) 829 830(define (stderr-log tmpl . args) 831 (apply format (current-error-port) tmpl args) 832 #f) 833 834(define (template-export report template export-type dry-run?) 835 (let* ((report-guid (gnc:report-template-report-guid template)) 836 (parent-template-guid (gnc:report-template-parent-type template)) 837 (template (if parent-template-guid 838 (hash-ref *gnc:_report-templates_* parent-template-guid) 839 template)) 840 (export-thunk (gnc:report-template-export-thunk template)) 841 (export-types (gnc:report-template-export-types template))) 842 843 (cond 844 ((not export-thunk) 845 (stderr-log "Only the following reports have export code:\n") 846 (show-selected-reports gnc:report-template-export-thunk (current-error-port)) 847 (stderr-log "Use -R show to describe report\n")) 848 ((not (assoc export-type export-types)) 849 (stderr-log "Export-type disallowed: ~a. Allowed types: ~a\n" 850 export-type (string-join (map car export-types) ", "))) 851 (dry-run? #t) 852 (else 853 (display "Running export..." (current-error-port)) 854 (let ((output (export-thunk 855 (gnc-report-find (gnc:make-report report-guid)) 856 (assoc-ref export-types export-type)))) 857 (display "done!\n" (current-error-port)) 858 output))))) 859 860(define (reportname->templates report) 861 (or (and=> (gnc:find-report-template report) list) 862 (hash-fold 863 (lambda (k v p) (if (equal? (gnc:report-template-name v) report) (cons v p) p)) 864 '() *gnc:_report-templates_*))) 865 866(define-public (gnc:cmdline-report-list port) 867 (show-selected-reports gnc:report-template-in-menu? port)) 868 869(define-public (gnc:cmdline-report-show report port) 870 (let ((templates (reportname->templates report))) 871 (cond 872 ((null? templates) 873 (stderr-log "Cannot find ~s. Valid reports:\n" report) 874 (gnc:cmdline-report-list (current-error-port))) 875 (else 876 (for-each 877 (lambda (template) 878 (let* ((options-gen (gnc:report-template-options-generator template)) 879 (parent-guid (gnc:report-template-parent-type template)) 880 (parent-template (and parent-guid 881 (hash-ref *gnc:_report-templates_* parent-guid))) 882 (export-types (gnc:report-template-export-types 883 (or parent-template template)))) 884 (format port "\n* name: ~a\n guid: ~a\n~a~a~a" 885 (gnc:report-template-name template) 886 (gnc:report-template-report-guid template) 887 (if parent-template 888 (format #f " parent-template: ~a\n" 889 (gnc:report-template-name parent-template)) 890 "") 891 (if export-types 892 (format #f " export-types: ~a\n" 893 (string-join (map car export-types) ", ")) "") 894 (gnc:html-render-options-changed (options-gen) #t)))) 895 templates))))) 896 897;; In: report - string matching reportname 898;; In: export-type - string matching export type (eg CSV TXF etc) 899;; Out: if args are valid and runs a single report: #t, otherwise: #f 900(define-public (gnc:cmdline-check-report report export-type) 901 (let ((templates (reportname->templates report))) 902 (cond 903 ((null? templates) 904 (stderr-log "Cannot find ~s. Valid reports:\n" report) 905 (gnc:cmdline-report-list (current-error-port)) 906 (stderr-log "\n")) 907 908 ((pair? (cdr templates)) 909 (stderr-log "~s matches multiple reports. Select guid instead:\n" report) 910 (gnc:cmdline-report-show report (current-error-port)) 911 (stderr-log "\n")) 912 913 (export-type (template-export report (car templates) 914 export-type #t)) 915 (else #t)))) 916 917;; In: report - string matching reportname 918;; In: export-type - string matching export type (eg CSV TXF etc) 919;; Out: if error, #f 920(define-public (gnc:cmdline-template-export report export-type) 921 (match (reportname->templates report) 922 ((template) (template-export report template export-type #f)) 923 (_ (gnc:error report " does not match unique report") #f))) 924 925;; In: report - string matching reportname 926;; Out: a number, or #f if error 927(define-public (gnc:cmdline-get-report-id report) 928 (match (reportname->templates report) 929 ((template) (gnc:make-report (gnc:report-template-report-guid template))) 930 (_ (gnc:error report " does not match unique report") #f))) 931