gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Feb 27 07:53:00 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/9dabe4a4 (commit)
via https://github.com/Gnucash/gnucash/commit/b8e9ce33 (commit)
via https://github.com/Gnucash/gnucash/commit/0f8558b7 (commit)
via https://github.com/Gnucash/gnucash/commit/5f436ae9 (commit)
via https://github.com/Gnucash/gnucash/commit/d49a51ca (commit)
via https://github.com/Gnucash/gnucash/commit/6e7cd333 (commit)
via https://github.com/Gnucash/gnucash/commit/afda3879 (commit)
via https://github.com/Gnucash/gnucash/commit/f0216583 (commit)
from https://github.com/Gnucash/gnucash/commit/8f8f5b84 (commit)
commit 9dabe4a4260a903c90b8c43183a22024e21739a7
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 27 19:07:16 2019 +0800
[report] further refactor gnc:define-report
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index ff9251f9c..00968a1f6 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -128,54 +128,57 @@ not found.")))
(modifier report-rec (cadr args))
(loop report-rec (cddr args)))))))
- (let ((report-rec (args-to-defn)))
- (if (and report-rec
- ;; only process reports that have a report-guid
- (gnc:report-template-report-guid report-rec))
- (let ((report-guid (gnc:report-template-report-guid report-rec)))
- (if (hash-ref *gnc:_report-templates_* report-guid)
- (begin
- (gui-error (string-append rpterr-dupe report-guid))
- #f)
- (hash-set! *gnc:_report-templates_* report-guid report-rec)))
- (begin
- (if (gnc:report-template-name report-rec)
- (begin
- (issue-deprecation-warning
- "report-definition without guid is deprecated. please define report with guid.")
- ;; we've got an old style report with no report-id, give it an arbitrary one
- (gnc:report-template-set-report-guid! report-rec (guid-new-return))
-
- ;; we also need to give it a parent-type, so that it will restore from the open state properly
- ;; we'll key that from the only known good way to tie back to the original report -- the renderer
- (hash-for-each
- (lambda (id rec)
- (if (and (equal? (gnc:report-template-renderer rec)
- (gnc:report-template-renderer report-rec))
- (not (gnc:report-template-parent-type rec)))
- (begin
- (gnc:warn "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
- (gnc:report-template-set-parent-type! report-rec (gnc:report-template-report-guid rec))
- (gnc:debug "done setting, is now " (gnc:report-template-parent-type report-rec)))))
- *gnc:_report-templates_*)
-
- (if (gnc:report-template-parent-type report-rec)
- (begin
- ;; re-save this old-style report in the new format
- (gnc:report-template-save-to-savefile report-rec)
- (gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
- (if (not gnc:old-style-report-warned)
- (begin
- (set! gnc:old-style-report-warned #t)
- (gui-error rpterr-upgraded)
- (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec))))
- ;;there is no parent -> this is an inital faulty report definition
- (gui-error (string-append rpterr-guid1
- (gnc:report-template-name report-rec)
- rpterr-guid2)))))
- #f ;; report definition is faulty: does not include name
- ;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
- ))))
+ (let* ((report-rec (args-to-defn))
+ (report-guid (gnc:report-template-report-guid report-rec))
+ (report-name (gnc:report-template-name report-rec)))
+ (cond
+
+ (report-guid
+ ;; ideal path: report is defined, and has guid
+ (if (hash-ref *gnc:_report-templates_* report-guid)
+ (gui-error (string-append rpterr-dupe report-guid))
+ (hash-set! *gnc:_report-templates_* report-guid report-rec)))
+
+ (report-name
+ ;; we've got an old style report with no report-guid
+ (issue-deprecation-warning
+ "old report definition without guid is deprecated.")
+
+ ;; give it an arbitrary one
+ (set! report-guid (guid-new-return))
+ (gnc:report-template-set-report-guid! report-rec report-guid)
+
+ ;; we also need to give it a parent-type, so that it will
+ ;; restore from the open state properly we'll key that from the
+ ;; only known good way to tie back to the original report -- the
+ ;; renderer
+ (hash-for-each
+ (lambda (id rec)
+ (if (and (equal? (gnc:report-template-renderer rec)
+ (gnc:report-template-renderer report-rec))
+ (not (gnc:report-template-parent-type rec)))
+ (begin
+ (gnc:warn "gnc:define-report: setting parent-type of " report-name
+ " to " (gnc:report-template-report-guid rec))
+ (gnc:report-template-set-parent-type!
+ report-rec (gnc:report-template-report-guid rec))
+ (gnc:debug "done setting, is now "
+ (gnc:report-template-parent-type report-rec)))))
+ *gnc:_report-templates_*)
+
+ (cond
+ ((gnc:report-template-parent-type report-rec)
+ ;; re-save this old-style report in the new format
+ (gnc:report-template-save-to-savefile report-rec)
+ (gnc:debug "complete saving " report-name " in new format")
+ (unless gnc:old-style-report-warned
+ (set! gnc:old-style-report-warned #t)
+ (gui-error rpterr-upgraded)
+ (hash-set! *gnc:_report-templates_* report-guid report-rec)))
+
+ (else
+ ;;there is no parent found -> this is an inital faulty report definition
+ (gui-error (string-append rpterr-guid1 report-name rpterr-guid2))))))))
(define gnc:report-template-version
(record-accessor <report-template> 'version))
commit b8e9ce33182ffeff03ff713bc90bc37097a8a6f5
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 27 18:55:15 2019 +0800
[report] deprecate report-without-guid handling
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 82dd02f78..ff9251f9c 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -141,6 +141,8 @@ not found.")))
(begin
(if (gnc:report-template-name report-rec)
(begin
+ (issue-deprecation-warning
+ "report-definition without guid is deprecated. please define report with guid.")
;; we've got an old style report with no report-id, give it an arbitrary one
(gnc:report-template-set-report-guid! report-rec (guid-new-return))
diff --git a/gnucash/report/report-system/test/test-report-system.scm b/gnucash/report/report-system/test/test-report-system.scm
index bb0895a47..22ba89b4c 100644
--- a/gnucash/report/report-system/test/test-report-system.scm
+++ b/gnucash/report/report-system/test/test-report-system.scm
@@ -36,6 +36,7 @@
;; -----------------------------------------------------------------------
(define (test-check2)
+ ;; this tests deprecated features
(display "\n*** Missing GUID detection:\n")
(gnc:define-report 'version "1"
'name "Test Report Template")
commit 0f8558b7f85d7e59ded83083acdb29b8a3d0a42a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Feb 11 23:30:33 2019 +0800
[report] refactor safely
1. upgrade <report-template> and constructor to top-level
2. convert (args-to-defn) to named-let
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 64ef074f2..82dd02f78 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -119,35 +119,16 @@ not found.")))
;; set of options, and generates the report. the renderer must
;; return as its final value an <html-document> object.
- (define (blank-report)
- ((record-constructor <report-template>)
- #f ;; version
- #f ;; name
- #f ;; report-guid
- #f ;; parent-type (meaning guid of report-template this template is based on)
- #f ;; options-generator
- #f ;; options-cleanup-cb
- #f ;; options-changed-cb
- #f ;; renderer
- #t ;; in-menu?
- #f ;; menu-path
- #f ;; menu-name
- #f ;; menu-tip
- #f ;; export-types
- #f ;; export-thunk
- ))
-
- (define (args-to-defn in-report-rec args)
- (let ((report-rec (or in-report-rec (blank-report))))
- (if (null? args)
- report-rec
- (let ((id (car args))
- (value (cadr args))
- (remainder (cddr args)))
- ((record-modifier <report-template> id) report-rec value)
- (args-to-defn report-rec remainder)))))
-
- (let ((report-rec (args-to-defn #f args)))
+ (define (args-to-defn)
+ (let loop ((report-rec (make-report-template)) (args args))
+ (cond
+ ((null? args) report-rec)
+ (else
+ (let ((modifier (record-modifier <report-template> (car args))))
+ (modifier report-rec (cadr args))
+ (loop report-rec (cddr args)))))))
+
+ (let ((report-rec (args-to-defn)))
(if (and report-rec
;; only process reports that have a report-guid
(gnc:report-template-report-guid report-rec))
@@ -228,6 +209,25 @@ not found.")))
(record-accessor <report-template> 'export-types))
(define gnc:report-template-export-thunk
(record-accessor <report-template> 'export-thunk))
+(define (make-report-template)
+ ((record-constructor <report-template>)
+ #f ;; version
+ #f ;; name
+ #f ;; report-guid
+ #f ;; parent-type (meaning guid of
+ ;; report-template this template is
+ ;; based on)
+ #f ;; options-generator
+ #f ;; options-cleanup-cb
+ #f ;; options-changed-cb
+ #f ;; renderer
+ #t ;; in-menu?
+ #f ;; menu-path
+ #f ;; menu-name
+ #f ;; menu-tip
+ #f ;; export-types
+ #f ;; export-thunk
+ ))
(define (gnc:report-template-new-options/report-guid template-id template-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-id)))
@@ -343,20 +343,22 @@ not found.")))
(define gnc:report-set-custom-template!
(record-modifier <report> 'custom-template))
+
;; gnc:make-report instantiates a report from a report-template.
;; The actual report is stored away in a hash-table -- only the id is returned.
(define (gnc:make-report template-id . rest)
- (let* ((template-parent (gnc:report-template-parent-type (hash-ref *gnc:_report-templates_* template-id)))
+ (let* ((template-parent (gnc:report-template-parent-type
+ (hash-ref *gnc:_report-templates_* template-id)))
(report-type (or template-parent template-id))
(custom-template (if template-parent template-id ""))
(r ((record-constructor <report>)
- report-type ;; type
- #f ;; id
- #f ;; options
- #t ;; dirty
- #f ;; needs-save
- #f ;; editor-widget
- #f ;; ctext
+ report-type ;; type
+ #f ;; id
+ #f ;; options
+ #t ;; dirty
+ #f ;; needs-save
+ #f ;; editor-widget
+ #f ;; ctext
custom-template ;; custom-template
))
(template (hash-ref *gnc:_report-templates_* template-id)))
@@ -369,10 +371,8 @@ not found.")))
(lambda ()
(gnc:report-set-dirty?! r #t)
(let ((cb (gnc:report-template-options-changed-cb template)))
- (if cb
- (cb r))))
+ (if cb (cb r))))
options))
-
(gnc:report-set-id! r (gnc-report-add r))
(gnc:report-id r)))
commit 5f436ae967ee8a6ed939d3235f06b981328cbbba
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Feb 5 23:19:26 2019 +0800
[report] simplify (gnc:report-render-html)
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 0c4abe35d..64ef074f2 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -758,30 +758,20 @@ not found.")))
(define (gnc:report-render-html report headers?)
(if (and (not (gnc:report-dirty? report))
(gnc:report-ctext report))
- ;; if there's clean cached text, return it
- ;;(begin
(gnc:report-ctext report)
- ;; )
-
- ;; otherwise, rerun the report
- (let ((template (hash-ref *gnc:_report-templates_*
- (gnc:report-type report)))
- (doc #f))
- (set! doc (if template
- (let* ((renderer (gnc:report-template-renderer template))
- (stylesheet (gnc:report-stylesheet report))
- (doc (renderer report))
- (html #f))
- (if (string? doc)
- (set! html doc)
- (begin
- (gnc:html-document-set-style-sheet! doc stylesheet)
- (set! html (gnc:html-document-render doc headers?))))
- (gnc:report-set-ctext! report html) ;; cache the html
- (gnc:report-set-dirty?! report #f) ;; mark it clean
- html)
- #f))
- doc))) ;; YUK! inner doc is html-doc object; outer doc is a string.
+ (let ((template (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
+ (and template
+ (let* ((renderer (gnc:report-template-renderer template))
+ (stylesheet (gnc:report-stylesheet report))
+ (doc (renderer report))
+ (html (cond
+ ((string? doc) doc)
+ (else
+ (gnc:html-document-set-style-sheet! doc stylesheet)
+ (gnc:html-document-render doc headers?)))))
+ (gnc:report-set-ctext! report html) ;; cache the html
+ (gnc:report-set-dirty?! report #f) ;; mark it clean
+ html)))))
;; looks up the report by id and renders it with gnc:report-render-html
;; marks the cursor busy during rendering; returns the html
commit d49a51ca736107deea0a66ac246f28b35c239de1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Feb 5 23:17:49 2019 +0800
[report] convert (gnc:restore-report) to use closure
Instead of a global variable gnc:old-style-restore-warned, use closure
to isolate variable within the only function which uses it.
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index e0dd60468..0c4abe35d 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -885,22 +885,21 @@ not found.")))
*gnc:_report-templates_*)
template-id))
-;; We want to warn users when we are trying to restore reports stored in the legacy
-;; format (based on name instead of guid), but only once
-(define gnc:old-style-restore-warned #f)
-
;; Legacy: this function is needed only to restore
;; a saved report when loading a book last saved in GnuCash 2.2
-(define (gnc:restore-report id template-name options)
- (if options
- (let ((r ((record-constructor <report>)
- (gnc:report-template-name-to-id template-name) id options #t #t #f #f "")))
- ;; Warn user (one time) we're attempting to restore old style reports
- (if (not gnc:old-style-restore-warned)
- (begin
- (set! gnc:old-style-restore-warned #t)
- (gnc-warning-dialog '() rptwarn-legacy)))
- (gnc-report-add r))
- (begin
+(define gnc:restore-report
+ (let ((first-warn? #t))
+ (lambda (id template-name options)
+ (cond
+ (options
+ (let* ((constructor (record-constructor <report>))
+ (template-id (gnc:report-template-name-to-id template-name))
+ (report (constructor template-id id options #t #t #f #f "")))
+ ;; Warn user (one time) we're attempting to restore old style reports
+ (when first-warn?
+ (set! first-warn? #f)
+ (gui-warning rptwarn-legacy))
+ (gnc-report-add report)))
+ (else
(gui-error-missing-template template-name)
- #f)))
+ #f)))))
commit 6e7cd3330839b5bafe6d10b8ffc9af220330a881
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Feb 5 22:28:22 2019 +0800
[report] centralize strings, (gui-error-dialog) logic
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 3f0e039a7..e0dd60468 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -86,6 +86,30 @@
renderer in-menu? menu-path menu-name
menu-tip export-types export-thunk)))
+;; define strings centrally to ease code clarity
+(define rpterr-dupe
+ (_ "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: "))
+(define rpterr-upgraded
+ (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))
+(define rpterr-guid1 (_ "Wrong report definition: "))
+(define rpterr-guid2 (_ " Report is missing a GUID."))
+(define rptwarn-legacy
+ (_ "Some reports stored in a legacy format were found. This format is not supported anymore so these reports may not have been restored properly."))
+(define (gui-error str)
+ (if (gnucash-ui-is-running)
+ (gnc-error-dialog '() str)
+ (gnc:error "report.scm error: " str)))
+(define (gui-warning str)
+ (if (gnucash-ui-is-running)
+ (gnc-warning-dialog '() str)
+ (gnc:warn "report.scm warning: " str)))
+(define (gui-error-missing-template template-name)
+ (gui-error
+ (string-append
+ "Report Failed! One of your previously opened reports has failed \
+to open. The template on which it was based: " template-name ", was \
+not found.")))
+
;; if args is supplied, it is a list of field names and values
(define (gnc:define-report . args)
;; For now the version is ignored, but in the future it'll let us
@@ -127,20 +151,12 @@
(if (and report-rec
;; only process reports that have a report-guid
(gnc:report-template-report-guid report-rec))
- (let* ((report-guid (gnc:report-template-report-guid report-rec))
- (name (gnc:report-template-name report-rec))
- (tmpl (hash-ref *gnc:_report-templates_* report-guid)))
- (if (not tmpl)
- (hash-set! *gnc:_report-templates_*
- report-guid report-rec)
+ (let ((report-guid (gnc:report-template-report-guid report-rec)))
+ (if (hash-ref *gnc:_report-templates_* report-guid)
(begin
- ;; FIXME: We should pass the top-level window
- ;; instead of the '() to gnc-error-dialog, but I
- ;; have no idea where to get it from.
- (and (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append
- (_ "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: ")
- report-guid))))))
+ (gui-error (string-append rpterr-dupe report-guid))
+ #f)
+ (hash-set! *gnc:_report-templates_* report-guid report-rec)))
(begin
(if (gnc:report-template-name report-rec)
(begin
@@ -168,15 +184,12 @@
(if (not gnc:old-style-report-warned)
(begin
(set! gnc:old-style-report-warned #t)
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
+ (gui-error rpterr-upgraded)
(hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec))))
;;there is no parent -> this is an inital faulty report definition
- (if (gnucash-ui-is-running)
- (gnc-error-dialog
- '() (string-append (_ "Wrong report definition: ")
- (gnc:report-template-name report-rec)
- (_ " Report is missing a GUID.")))))))
+ (gui-error (string-append rpterr-guid1
+ (gnc:report-template-name report-rec)
+ rpterr-guid2)))))
#f ;; report definition is faulty: does not include name
;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
))))
@@ -372,10 +385,8 @@
(if (number? report-id)
(gnc:report-set-id! r report-id))
report-id)
- (let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() errmsg)
- (gnc:warn errmsg))
+ (begin
+ (gui-error-missing-template template-name)
#f)))
(define (gnc:restore-report-by-guid-with-custom-template
@@ -387,10 +398,8 @@
(if (number? report-id)
(gnc:report-set-id! r report-id))
report-id)
- (let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() errmsg)
- (gnc:warn errmsg))
+ (begin
+ (gui-error-missing-template template-name)
#f)))
(define (gnc:make-report-options template-id)
@@ -886,14 +895,12 @@
(if options
(let ((r ((record-constructor <report>)
(gnc:report-template-name-to-id template-name) id options #t #t #f #f "")))
- ;; Warn user (one time) we're attempting to restore old style reports
- (if (not gnc:old-style-restore-warned)
- (begin
- (set! gnc:old-style-restore-warned #t)
- (gnc-warning-dialog '() (string-append (_ "Some reports stored in a legacy format were found. This format is not supported anymore so these reports may not have been restored properly.")))))
- (gnc-report-add r))
- (let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() errmsg)
- (gnc:warn errmsg))
+ ;; Warn user (one time) we're attempting to restore old style reports
+ (if (not gnc:old-style-restore-warned)
+ (begin
+ (set! gnc:old-style-restore-warned #t)
+ (gnc-warning-dialog '() rptwarn-legacy)))
+ (gnc-report-add r))
+ (begin
+ (gui-error-missing-template template-name)
#f)))
commit afda3879881c2e5f9297498d74dfc004eda60c89
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 10 18:10:18 2019 +0800
[report] enforce gnu coding style
no dangling parentheses
(if a a b) -> (or a b)
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index e64aa3c5b..3f0e039a7 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -78,12 +78,13 @@
;; A <report-template> represents one of the available report types.
(define <report-template>
- (make-record-type "<report-template>"
- ;; The data items in a report record
- '(version name report-guid parent-type options-generator
- options-cleanup-cb options-changed-cb
- renderer in-menu? menu-path menu-name
- menu-tip export-types export-thunk)))
+ (make-record-type
+ "<report-template>"
+ ;; The data items in a report record
+ '(version name report-guid parent-type options-generator
+ options-cleanup-cb options-changed-cb
+ renderer in-menu? menu-path menu-name
+ menu-tip export-types export-thunk)))
;; if args is supplied, it is a list of field names and values
(define (gnc:define-report . args)
@@ -113,9 +114,7 @@
))
(define (args-to-defn in-report-rec args)
- (let ((report-rec (if in-report-rec
- in-report-rec
- (blank-report))))
+ (let ((report-rec (or in-report-rec (blank-report))))
(if (null? args)
report-rec
(let ((id (car args))
@@ -138,12 +137,10 @@
;; FIXME: We should pass the top-level window
;; instead of the '() to gnc-error-dialog, but I
;; have no idea where to get it from.
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append
- (_ "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: ")
- report-guid))
- #f)
- )))
+ (and (gnucash-ui-is-running)
+ (gnc-error-dialog '() (string-append
+ (_ "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: ")
+ report-guid))))))
(begin
(if (gnc:report-template-name report-rec)
(begin
@@ -173,23 +170,15 @@
(set! gnc:old-style-report-warned #t)
(if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
- (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
- )
- )
- )
+ (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec))))
;;there is no parent -> this is an inital faulty report definition
(if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
- (gnc:report-template-name report-rec)
- (_ " Report is missing a GUID.")))
- )
- )
- )
- )
+ (gnc-error-dialog
+ '() (string-append (_ "Wrong report definition: ")
+ (gnc:report-template-name report-rec)
+ (_ " Report is missing a GUID.")))))))
#f ;; report definition is faulty: does not include name
-
;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
-
))))
(define gnc:report-template-version
@@ -229,22 +218,19 @@
(define (gnc:report-template-new-options/report-guid template-id template-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-id)))
- (if templ
- (gnc:report-template-new-options templ)
- #f)))
+ (and templ
+ (gnc:report-template-new-options templ))))
(define (gnc:report-template-menu-name/report-guid template-id template-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-id)))
- (if templ
- (or (gnc:report-template-menu-name templ)
- (gnc:report-template-name templ))
- #f)))
+ (and templ
+ (or (gnc:report-template-menu-name templ)
+ (gnc:report-template-name templ)))))
(define (gnc:report-template-renderer/report-guid template-id template-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-id)))
- (if templ
- (gnc:report-template-renderer templ)
- #f)))
+ (and templ
+ (gnc:report-template-renderer templ))))
(define (gnc:report-template-new-options report-template)
(let ((generator (gnc:report-template-options-generator report-template))
@@ -267,15 +253,14 @@
" " (_ "stylesheet."))))
(gnc:get-html-style-sheets)))))
- (let ((options
- (if (procedure? generator)
- (or (gnc:backtrace-if-exception generator)
- (begin
- (gnc:warn "BUG DETECTED: Scheme exception raised in "
- "report options generator procedure named "
- (procedure-name generator))
- (gnc:new-options)))
- (gnc:new-options))))
+ (let ((options (if (procedure? generator)
+ (or (gnc:backtrace-if-exception generator)
+ (begin
+ (gnc:warn "BUG DETECTED: Scheme exception raised in "
+ "report options generator procedure named "
+ (procedure-name generator))
+ (gnc:new-options)))
+ (gnc:new-options))))
(or (gnc:lookup-option options gnc:pagename-general gnc:optname-reportname)
(gnc:register-option options namer))
(or (gnc:lookup-option options gnc:pagename-general gnc:optname-stylesheet)
@@ -284,8 +269,9 @@
;; A <report> represents an instantiation of a particular report type.
(define <report>
- (make-record-type "<report>"
- '(type id options dirty? needs-save? editor-widget ctext custom-template)))
+ (make-record-type
+ "<report>"
+ '(type id options dirty? needs-save? editor-widget ctext custom-template)))
(define gnc:report-type
(record-accessor <report> 'type))
@@ -321,7 +307,7 @@
(gnc:report-set-dirty?-internal! report val)
(let* ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report)))
- (cb (gnc:report-template-options-changed-cb template)))
+ (cb (gnc:report-template-options-changed-cb template)))
(if (and cb (procedure? cb))
(cb report))))
@@ -348,12 +334,8 @@
;; The actual report is stored away in a hash-table -- only the id is returned.
(define (gnc:make-report template-id . rest)
(let* ((template-parent (gnc:report-template-parent-type (hash-ref *gnc:_report-templates_* template-id)))
- (report-type (if template-parent
- template-parent
- template-id))
- (custom-template (if template-parent
- template-id
- ""))
+ (report-type (or template-parent template-id))
+ (custom-template (if template-parent template-id ""))
(r ((record-constructor <report>)
report-type ;; type
#f ;; id
@@ -364,12 +346,10 @@
#f ;; ctext
custom-template ;; custom-template
))
- (template (hash-ref *gnc:_report-templates_* template-id))
- )
- (let ((options
- (if (not (null? rest))
- (car rest)
- (gnc:report-template-new-options template))))
+ (template (hash-ref *gnc:_report-templates_* template-id)))
+ (let ((options (if (null? rest)
+ (gnc:report-template-new-options template)
+ (car rest))))
(gnc:report-set-options! r options)
(gnc:options-register-callback
#f #f
@@ -381,87 +361,71 @@
options))
(gnc:report-set-id! r (gnc-report-add r))
- (gnc:report-id r))
- )
+ (gnc:report-id r)))
(define (gnc:restore-report-by-guid id template-id template-name options)
(if options
- (let* (
- (r ((record-constructor <report>)
+ (let* ((r ((record-constructor <report>)
template-id id options #t #t #f #f ""))
- (report-id (gnc-report-add r))
- )
+ (report-id (gnc-report-add r)))
(if (number? report-id)
- (gnc:report-set-id! r report-id)
- )
- report-id
- )
+ (gnc:report-set-id! r report-id))
+ report-id)
(let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
(if (gnucash-ui-is-running)
(gnc-error-dialog '() errmsg)
(gnc:warn errmsg))
- #f))
- )
+ #f)))
(define (gnc:restore-report-by-guid-with-custom-template
id template-id template-name custom-template-id options)
(if options
- (let* (
- (r ((record-constructor <report>)
+ (let* ((r ((record-constructor <report>)
template-id id options #t #t #f #f custom-template-id))
- (report-id (gnc-report-add r))
- )
+ (report-id (gnc-report-add r)))
(if (number? report-id)
- (gnc:report-set-id! r report-id)
- )
- report-id
- )
+ (gnc:report-set-id! r report-id))
+ report-id)
(let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
(if (gnucash-ui-is-running)
(gnc-error-dialog '() errmsg)
(gnc:warn errmsg))
- #f))
- )
+ #f)))
(define (gnc:make-report-options template-id)
(let ((template (hash-ref *gnc:_report-templates_* template-id)))
- (if template
- (gnc:report-template-new-options template)
- #f)))
+ (and template
+ (gnc:report-template-new-options template))))
;; A convenience wrapper to get the report-template's export types from
;; an instantiated report.
(define (gnc:report-export-types report)
(let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
- (if template
- (gnc:report-template-export-types template)
- #f)))
+ (and template
+ (gnc:report-template-export-types template))))
;; A convenience wrapper to get the report-template's export thunk from
;; an instantiated report.
(define (gnc:report-export-thunk report)
(let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
- (if template
- (gnc:report-template-export-thunk template)
- #f)))
+ (and template
+ (gnc:report-template-export-thunk template))))
(define (gnc:report-menu-name report)
(let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
- (if template
- (or (gnc:report-template-menu-name template)
- (gnc:report-name report))
- #f)))
+ (and template
+ (or (gnc:report-template-menu-name template)
+ (gnc:report-name report)))))
(define (gnc:report-name report)
(let* ((opt (gnc:report-options report)))
- (if opt
- (gnc:option-value
- (gnc:lookup-option opt gnc:pagename-general gnc:optname-reportname))
- #f)))
+ (and opt
+ (gnc:option-value
+ (gnc:lookup-option opt gnc:pagename-general gnc:optname-reportname)))))
(define (gnc:report-stylesheet report)
(gnc:html-style-sheet-find
@@ -504,12 +468,12 @@
(hash-ref *gnc:_report-templates_* report-type))
(define (gnc:report-template-is-custom/template-guid? guid)
- (let* ((custom-template (if (string? guid) (if (string-null? guid) #f (hash-ref *gnc:_report-templates_* guid)) #f))
- (parent-type (if custom-template (gnc:report-template-parent-type custom-template) #f)))
-
- (if parent-type
- #t
- #f)))
+ (let* ((custom-template (and (string? guid)
+ (not (string-null? guid))
+ (hash-ref *gnc:_report-templates_* guid))))
+ (and custom-template
+ (gnc:report-template-parent-type custom-template)
+ #t)))
(define (gnc:is-custom-report-type report)
(gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report)))
@@ -519,7 +483,6 @@
;; If not the calling function can prevent the name from being updated.
(define (gnc:report-template-has-unique-name? templ-guid new-name)
(let* ((unique? #t))
-
(if new-name
(hash-for-each
(lambda (id rec)
@@ -537,7 +500,6 @@
(let* ((unique-name new-name)
(counter 0)
(unique? (gnc:report-template-has-unique-name? #f unique-name)))
-
(while (not unique?)
(begin
(set! counter (+ counter 1))
@@ -596,13 +558,11 @@
(begin
(for-each
(lambda (subreport-id)
- (let* (
- (subreport (gnc-report-find subreport-id))
+ (let* ((subreport (gnc-report-find subreport-id))
(subreport-type (gnc:report-type subreport))
(subreport-template (hash-ref *gnc:_report-templates_* subreport-type))
(subreport-template-name (gnc:report-template-name subreport-template))
- (thunk (gnc:report-template-options-cleanup-cb subreport-template))
- )
+ (thunk (gnc:report-template-options-cleanup-cb subreport-template)))
;; clean up the options if necessary. this is only needed
;; in special cases.
(if thunk
@@ -622,11 +582,7 @@
subreport-type
subreport-template-name
(gnc:report-custom-template subreport))
- " )\n"
- )
- )
- )
- )
+ " )\n"))))
embedded-reports)
;;(set! result-string (string-append result-string (gnc:update-section-general)))
(set! result-string
@@ -646,14 +602,8 @@
" )\n"
" option\n"
" )\n"
- " )\n"
- )
- )
- )
- )
- result-string
- )
- )
+ " )\n"))))
+ result-string))
(define (gnc:report-template-serialize-internal name type templ-name options guid)
(let* ((embedded-serialized (gnc:report-serialize-embedded (gnc:report-embedded-list options)))
@@ -672,8 +622,7 @@
(format
#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"
name
- (if guid
- guid
+ (or guid
(guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading
type
type
@@ -686,9 +635,7 @@
(define (gnc:report-template-serialize-from-report report)
;; clean up the options if necessary. this is only needed
;; in special cases.
- (let* ((template
- (hash-ref *gnc:_report-templates_*
- (gnc:report-type report)))
+ (let* ((template (hash-ref *gnc:_report-templates_* (gnc:report-type report)))
(thunk (gnc:report-template-options-cleanup-cb template)))
(if thunk
(thunk report)))
@@ -736,32 +683,30 @@
;; (Bug #342206)
(save-result (eval-string saved-form)))
- (if (record? save-result)
- (begin
- ;; If it's ok to overwrite the old template, delete it now.
- (if overwrite-ok?
- (let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
- ;; We're overwriting, which needs some additional steps
- ;; 1. Remove the newly generated template from the template list again
- (hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
- ;; 2. We still have the template record available though, so adapt it to
- ;; the template we want to override (ie update guid and name)
- (gnc:report-template-set-report-guid! save-result custom-template-id)
- (gnc:report-template-set-name save-result templ-name)
- ;; 3. Overwrite the template with the new one
- (hash-set! *gnc:_report-templates_* custom-template-id save-result)
- ))
-
- ;; Regardless of how we got here, we now have a new template to write
- ;; so let's write it
- (if (gnc:save-all-reports)
- (let ((templ-guid (gnc:report-template-report-guid save-result)))
- ;; Indicate the report was instantiated from the new template
- (gnc:report-set-custom-template! report templ-guid)
- ;; Inform the calling function of the new template's guid
- templ-guid)
- #f))
- #f)))
+ (and (record? save-result)
+ (begin
+ ;; If it's ok to overwrite the old template, delete it now.
+ (if overwrite-ok?
+ (let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
+ ;; We're overwriting, which needs some additional steps
+ ;; 1. Remove the newly generated template from the template list again
+ (hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
+ ;; 2. We still have the template record available though, so adapt it to
+ ;; the template we want to override (ie update guid and name)
+ (gnc:report-template-set-report-guid! save-result custom-template-id)
+ (gnc:report-template-set-name save-result templ-name)
+ ;; 3. Overwrite the template with the new one
+ (hash-set! *gnc:_report-templates_* custom-template-id save-result)
+ ))
+
+ ;; Regardless of how we got here, we now have a new template to write
+ ;; so let's write it
+ (and (gnc:save-all-reports)
+ (let ((templ-guid (gnc:report-template-report-guid save-result)))
+ ;; Indicate the report was instantiated from the new template
+ (gnc:report-set-custom-template! report templ-guid)
+ ;; Inform the calling function of the new template's guid
+ templ-guid))))))
;; Convert a report into a new report template and add this template to the save file
(define (gnc:report-to-template-new report)
@@ -784,14 +729,14 @@
(let ((save-ok? #t))
(gnc-saved-reports-backup)
(gnc-saved-reports-write-to-file "" #t)
- (hash-for-each (lambda (k v)
- (if (gnc:report-template-parent-type v)
- (begin
- (gnc:debug "saving report " k)
- (if (not (gnc:report-template-save-to-savefile v))
- (set! save-ok? #f)
- ))))
- *gnc:_report-templates_*)
+ (hash-for-each
+ (lambda (k v)
+ (if (gnc:report-template-parent-type v)
+ (begin
+ (gnc:debug "saving report " k)
+ (if (not (gnc:report-template-save-to-savefile v))
+ (set! save-ok? #f)))))
+ *gnc:_report-templates_*)
save-ok?))
@@ -853,16 +798,17 @@
;; "thunk" should take the report-type and the report template record
(define (gnc:report-templates-for-each thunk)
- (hash-for-each (lambda (report-id template) (thunk report-id template))
- *gnc:_report-templates_*))
+ (hash-for-each
+ (lambda (report-id template)
+ (thunk report-id template))
+ *gnc:_report-templates_*))
;; return the list of reports embedded in the specified report
(define (gnc:report-embedded-list options)
(let* ((option (gnc:lookup-option options "__general" "report-list")))
- (if option
- (let ((opt-value (gnc:option-value option)))
- (map (lambda (x) (car x)) opt-value))
- #f)))
+ (and option
+ (let ((opt-value (gnc:option-value option)))
+ (map car opt-value)))))
;; delete an existing report from the hash table and then call to
;; resave the saved-reports file... report is gone
@@ -877,11 +823,10 @@
;; resave the saved-reports file
(define (gnc:rename-report template-guid new-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-guid)))
- (if templ
- (begin
- (gnc:debug "Renaming report " template-guid)
- (gnc:report-template-set-name templ new-name)
- (gnc:save-all-reports)))))
+ (when templ
+ (gnc:debug "Renaming report " template-guid)
+ (gnc:report-template-set-name templ new-name)
+ (gnc:save-all-reports))))
;; Legacy functions
;;;;;;;;;;;;;;;;;;;
@@ -894,31 +839,31 @@
(hash-for-each
(lambda (id rec)
(if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id)))) *gnc:_report-templates_*)
- (if templ
- (gnc:report-template-new-options templ)
- #f)))
+ (set! templ (hash-ref *gnc:_report-templates_* id))))
+ *gnc:_report-templates_*)
+ (and templ
+ (gnc:report-template-new-options templ))))
(define (gnc:report-template-menu-name/name template-name)
(let ((templ #f))
(hash-for-each
(lambda (id rec)
(if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id)))) *gnc:_report-templates_*)
- (if templ
- (or (gnc:report-template-menu-name templ)
- (gnc:report-template-name templ))
- #f)))
+ (set! templ (hash-ref *gnc:_report-templates_* id))))
+ *gnc:_report-templates_*)
+ (and templ
+ (or (gnc:report-template-menu-name templ)
+ (gnc:report-template-name templ)))))
(define (gnc:report-template-renderer/name template-name)
(let ((templ #f))
(hash-for-each
(lambda (id rec)
(if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id)))) *gnc:_report-templates_*)
- (if templ
- (gnc:report-template-renderer templ)
- #f)))
+ (set! templ (hash-ref *gnc:_report-templates_* id))))
+ *gnc:_report-templates_*)
+ (and templ
+ (gnc:report-template-renderer templ))))
;; Used internally only to convert a report template name into a corresponding guid
;; Note that this may fail if several reports exist with the same name
@@ -927,7 +872,8 @@
(hash-for-each
(lambda (id rec)
(if (equal? template-name (gnc:report-template-name rec))
- (set! template-id id))) *gnc:_report-templates_*)
+ (set! template-id id)))
+ *gnc:_report-templates_*)
template-id))
;; We want to warn users when we are trying to restore reports stored in the legacy
commit f021658382b6b26a83dc1884c30529c39f7c84b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 10 17:52:27 2019 +0800
[report] *delete-trailing-whitespace/reindent/untabify*
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index bace494d6..e64aa3c5b 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -23,9 +23,8 @@
(use-modules (gnucash utilities))
(use-modules (gnucash app-utils))
(use-modules (gnucash gettext))
-(eval-when
- (compile load eval expand)
- (load-extension "libgncmod-report-system" "scm_init_sw_report_system_module"))
+(eval-when (compile load eval expand)
+ (load-extension "libgncmod-report-system" "scm_init_sw_report_system_module"))
(use-modules (sw_report_system))
;; Terminology in this file:
@@ -120,78 +119,78 @@
(if (null? args)
report-rec
(let ((id (car args))
- (value (cadr args))
- (remainder (cddr args)))
+ (value (cadr args))
+ (remainder (cddr args)))
((record-modifier <report-template> id) report-rec value)
(args-to-defn report-rec remainder)))))
(let ((report-rec (args-to-defn #f args)))
(if (and report-rec
- ;; only process reports that have a report-guid
+ ;; only process reports that have a report-guid
(gnc:report-template-report-guid report-rec))
- (let* ((report-guid (gnc:report-template-report-guid report-rec))
- (name (gnc:report-template-name report-rec))
- (tmpl (hash-ref *gnc:_report-templates_* report-guid)))
- (if (not tmpl)
- (hash-set! *gnc:_report-templates_*
- report-guid report-rec)
- (begin
- ;; FIXME: We should pass the top-level window
- ;; instead of the '() to gnc-error-dialog, but I
- ;; have no idea where to get it from.
+ (let* ((report-guid (gnc:report-template-report-guid report-rec))
+ (name (gnc:report-template-name report-rec))
+ (tmpl (hash-ref *gnc:_report-templates_* report-guid)))
+ (if (not tmpl)
+ (hash-set! *gnc:_report-templates_*
+ report-guid report-rec)
+ (begin
+ ;; FIXME: We should pass the top-level window
+ ;; instead of the '() to gnc-error-dialog, but I
+ ;; have no idea where to get it from.
(if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append
- (_ "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: ")
- report-guid))
- #f)
- )))
- (begin
- (if (gnc:report-template-name report-rec)
- (begin
- ;; we've got an old style report with no report-id, give it an arbitrary one
- (gnc:report-template-set-report-guid! report-rec (guid-new-return))
-
- ;; we also need to give it a parent-type, so that it will restore from the open state properly
- ;; we'll key that from the only known good way to tie back to the original report -- the renderer
- (hash-for-each
- (lambda (id rec)
- (if (and (equal? (gnc:report-template-renderer rec)
- (gnc:report-template-renderer report-rec))
- (not (gnc:report-template-parent-type rec)))
- (begin
- (gnc:warn "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
- (gnc:report-template-set-parent-type! report-rec (gnc:report-template-report-guid rec))
- (gnc:debug "done setting, is now " (gnc:report-template-parent-type report-rec)))))
- *gnc:_report-templates_*)
+ (gnc-error-dialog '() (string-append
+ (_ "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: ")
+ report-guid))
+ #f)
+ )))
+ (begin
+ (if (gnc:report-template-name report-rec)
+ (begin
+ ;; we've got an old style report with no report-id, give it an arbitrary one
+ (gnc:report-template-set-report-guid! report-rec (guid-new-return))
+
+ ;; we also need to give it a parent-type, so that it will restore from the open state properly
+ ;; we'll key that from the only known good way to tie back to the original report -- the renderer
+ (hash-for-each
+ (lambda (id rec)
+ (if (and (equal? (gnc:report-template-renderer rec)
+ (gnc:report-template-renderer report-rec))
+ (not (gnc:report-template-parent-type rec)))
+ (begin
+ (gnc:warn "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
+ (gnc:report-template-set-parent-type! report-rec (gnc:report-template-report-guid rec))
+ (gnc:debug "done setting, is now " (gnc:report-template-parent-type report-rec)))))
+ *gnc:_report-templates_*)
(if (gnc:report-template-parent-type report-rec)
- (begin
- ;; re-save this old-style report in the new format
- (gnc:report-template-save-to-savefile report-rec)
- (gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
- (if (not gnc:old-style-report-warned)
- (begin
- (set! gnc:old-style-report-warned #t)
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
- (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
+ (begin
+ ;; re-save this old-style report in the new format
+ (gnc:report-template-save-to-savefile report-rec)
+ (gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
+ (if (not gnc:old-style-report-warned)
+ (begin
+ (set! gnc:old-style-report-warned #t)
+ (if (gnucash-ui-is-running)
+ (gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
+ (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
+ )
+ )
)
+ ;;there is no parent -> this is an inital faulty report definition
+ (if (gnucash-ui-is-running)
+ (gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
+ (gnc:report-template-name report-rec)
+ (_ " Report is missing a GUID.")))
+ )
)
- )
- ;;there is no parent -> this is an inital faulty report definition
- (if (gnucash-ui-is-running)
- (gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
- (gnc:report-template-name report-rec)
- (_ " Report is missing a GUID.")))
- )
)
)
- )
#f ;; report definition is faulty: does not include name
- ;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
+ ;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
- ))))
+ ))))
(define gnc:report-template-version
(record-accessor <report-template> 'version))
@@ -249,22 +248,22 @@
(define (gnc:report-template-new-options report-template)
(let ((generator (gnc:report-template-options-generator report-template))
- (namer
- (gnc:make-string-option
+ (namer
+ (gnc:make-string-option
gnc:pagename-general gnc:optname-reportname "0a"
(N_ "Enter a descriptive name for this report.")
(_ (gnc:report-template-name report-template))))
- (stylesheet
- (gnc:make-multichoice-option
+ (stylesheet
+ (gnc:make-multichoice-option
gnc:pagename-general gnc:optname-stylesheet "0b"
(N_ "Select a stylesheet for the report.")
(string->symbol (N_ "Default"))
- (map
+ (map
(lambda (ss)
- (vector
+ (vector
(string->symbol (gnc:html-style-sheet-name ss))
(gnc:html-style-sheet-name ss)
- (string-append (gnc:html-style-sheet-name ss)
+ (string-append (gnc:html-style-sheet-name ss)
" " (_ "stylesheet."))))
(gnc:get-html-style-sheets)))))
@@ -288,31 +287,31 @@
(make-record-type "<report>"
'(type id options dirty? needs-save? editor-widget ctext custom-template)))
-(define gnc:report-type
+(define gnc:report-type
(record-accessor <report> 'type))
(define gnc:report-set-type!
(record-modifier <report> 'type))
-(define gnc:report-id
+(define gnc:report-id
(record-accessor <report> 'id))
(define gnc:report-set-id!
(record-modifier <report> 'id))
-(define gnc:report-options
+(define gnc:report-options
(record-accessor <report> 'options))
(define gnc:report-set-options!
(record-modifier <report> 'options))
-(define gnc:report-needs-save?
+(define gnc:report-needs-save?
(record-accessor <report> 'needs-save?))
(define gnc:report-set-needs-save?!
(record-modifier <report> 'needs-save?))
-(define gnc:report-dirty?
+(define gnc:report-dirty?
(record-accessor <report> 'dirty?))
(define gnc:report-set-dirty?-internal!
@@ -320,20 +319,20 @@
(define (gnc:report-set-dirty?! report val)
(gnc:report-set-dirty?-internal! report val)
- (let* ((template (hash-ref *gnc:_report-templates_*
+ (let* ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report)))
(cb (gnc:report-template-options-changed-cb template)))
(if (and cb (procedure? cb))
(cb report))))
-(define gnc:report-editor-widget
+(define gnc:report-editor-widget
(record-accessor <report> 'editor-widget))
(define gnc:report-set-editor-widget!
(record-modifier <report> 'editor-widget))
;; ctext is for caching the rendered html
-(define gnc:report-ctext
+(define gnc:report-ctext
(record-accessor <report> 'ctext))
(define gnc:report-set-ctext!
@@ -349,32 +348,32 @@
;; The actual report is stored away in a hash-table -- only the id is returned.
(define (gnc:make-report template-id . rest)
(let* ((template-parent (gnc:report-template-parent-type (hash-ref *gnc:_report-templates_* template-id)))
- (report-type (if template-parent
- template-parent
- template-id))
+ (report-type (if template-parent
+ template-parent
+ template-id))
(custom-template (if template-parent
template-id
""))
- (r ((record-constructor <report>)
- report-type ;; type
- #f ;; id
- #f ;; options
- #t ;; dirty
- #f ;; needs-save
- #f ;; editor-widget
- #f ;; ctext
- custom-template ;; custom-template
- ))
- (template (hash-ref *gnc:_report-templates_* template-id))
- )
- (let ((options
+ (r ((record-constructor <report>)
+ report-type ;; type
+ #f ;; id
+ #f ;; options
+ #t ;; dirty
+ #f ;; needs-save
+ #f ;; editor-widget
+ #f ;; ctext
+ custom-template ;; custom-template
+ ))
+ (template (hash-ref *gnc:_report-templates_* template-id))
+ )
+ (let ((options
(if (not (null? rest))
(car rest)
(gnc:report-template-new-options template))))
(gnc:report-set-options! r options)
- (gnc:options-register-callback
- #f #f
- (lambda ()
+ (gnc:options-register-callback
+ #f #f
+ (lambda ()
(gnc:report-set-dirty?! r #t)
(let ((cb (gnc:report-template-options-changed-cb template)))
(if cb
@@ -389,32 +388,33 @@
(define (gnc:restore-report-by-guid id template-id template-name options)
(if options
(let* (
- (r ((record-constructor <report>)
- template-id id options #t #t #f #f ""))
- (report-id (gnc-report-add r))
+ (r ((record-constructor <report>)
+ template-id id options #t #t #f #f ""))
+ (report-id (gnc-report-add r))
+ )
+ (if (number? report-id)
+ (gnc:report-set-id! r report-id)
)
- (if (number? report-id)
- (gnc:report-set-id! r report-id)
- )
report-id
)
(let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
- (if (gnucash-ui-is-running)
+ (if (gnucash-ui-is-running)
(gnc-error-dialog '() errmsg)
(gnc:warn errmsg))
- #f))
+ #f))
)
-(define (gnc:restore-report-by-guid-with-custom-template id template-id template-name custom-template-id options)
+(define (gnc:restore-report-by-guid-with-custom-template
+ id template-id template-name custom-template-id options)
(if options
(let* (
- (r ((record-constructor <report>)
+ (r ((record-constructor <report>)
template-id id options #t #t #f #f custom-template-id))
- (report-id (gnc-report-add r))
+ (report-id (gnc-report-add r))
+ )
+ (if (number? report-id)
+ (gnc:report-set-id! r report-id)
)
- (if (number? report-id)
- (gnc:report-set-id! r report-id)
- )
report-id
)
(let ((errmsg (string-append "Report Failed! One of your previously opened reports has failed to open. The template on which it was based: " template-name ", was not found.")))
@@ -433,7 +433,7 @@
;; A convenience wrapper to get the report-template's export types from
;; an instantiated report.
(define (gnc:report-export-types report)
- (let ((template (hash-ref *gnc:_report-templates_*
+ (let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
(if template
(gnc:report-template-export-types template)
@@ -442,21 +442,21 @@
;; A convenience wrapper to get the report-template's export thunk from
;; an instantiated report.
(define (gnc:report-export-thunk report)
- (let ((template (hash-ref *gnc:_report-templates_*
+ (let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
(if template
(gnc:report-template-export-thunk template)
#f)))
(define (gnc:report-menu-name report)
- (let ((template (hash-ref *gnc:_report-templates_*
+ (let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
(if template
(or (gnc:report-template-menu-name template)
- (gnc:report-name report))
+ (gnc:report-name report))
#f)))
-(define (gnc:report-name report)
+(define (gnc:report-name report)
(let* ((opt (gnc:report-options report)))
(if opt
(gnc:option-value
@@ -464,52 +464,52 @@
#f)))
(define (gnc:report-stylesheet report)
- (gnc:html-style-sheet-find
+ (gnc:html-style-sheet-find
(symbol->string (gnc:option-value
- (gnc:lookup-option
+ (gnc:lookup-option
(gnc:report-options report)
- gnc:pagename-general
+ gnc:pagename-general
gnc:optname-stylesheet)))))
(define (gnc:report-set-stylesheet! report stylesheet)
(gnc:option-set-value
- (gnc:lookup-option
+ (gnc:lookup-option
(gnc:report-options report)
- gnc:pagename-general
+ gnc:pagename-general
gnc:optname-stylesheet)
- (string->symbol
+ (string->symbol
(gnc:html-style-sheet-name stylesheet))))
;; Load and save helper functions
(define (gnc:all-report-template-guids)
- (hash-fold
- (lambda (k v p)
- (cons k p))
- '() *gnc:_report-templates_*))
+ (hash-fold
+ (lambda (k v p)
+ (cons k p))
+ '() *gnc:_report-templates_*))
;; return a list of the custom report template guids.
(define (gnc:custom-report-template-guids)
- (hash-fold
- (lambda (k v p)
- (if (gnc:report-template-parent-type v)
- (begin
- (gnc:debug "template " v)
- (cons k p))
- p))
- '() *gnc:_report-templates_*))
-
-(define (gnc:find-report-template report-type)
+ (hash-fold
+ (lambda (k v p)
+ (if (gnc:report-template-parent-type v)
+ (begin
+ (gnc:debug "template " v)
+ (cons k p))
+ p))
+ '() *gnc:_report-templates_*))
+
+(define (gnc:find-report-template report-type)
(hash-ref *gnc:_report-templates_* report-type))
(define (gnc:report-template-is-custom/template-guid? guid)
(let* ((custom-template (if (string? guid) (if (string-null? guid) #f (hash-ref *gnc:_report-templates_* guid)) #f))
(parent-type (if custom-template (gnc:report-template-parent-type custom-template) #f)))
- (if parent-type
- #t
- #f)))
+ (if parent-type
+ #t
+ #f)))
(define (gnc:is-custom-report-type report)
(gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report)))
@@ -520,14 +520,14 @@
(define (gnc:report-template-has-unique-name? templ-guid new-name)
(let* ((unique? #t))
- (if new-name
- (hash-for-each
- (lambda (id rec)
- (if (and (not (equal? templ-guid id))
- (gnc:report-template-is-custom/template-guid? id)
- (equal? new-name (gnc:report-template-name rec)))
- (set! unique? #f)))
- *gnc:_report-templates_*))
+ (if new-name
+ (hash-for-each
+ (lambda (id rec)
+ (if (and (not (equal? templ-guid id))
+ (gnc:report-template-is-custom/template-guid? id)
+ (equal? new-name (gnc:report-template-name rec)))
+ (set! unique? #f)))
+ *gnc:_report-templates_*))
unique?))
;; Generate a unique custom template name using the given string as a base
@@ -540,9 +540,9 @@
(while (not unique?)
(begin
- (set! counter (+ counter 1))
- (set! unique-name (string-append new-name (number->string counter)))
- (set! unique? (gnc:report-template-has-unique-name? #f unique-name))))
+ (set! counter (+ counter 1))
+ (set! unique-name (string-append new-name (number->string counter)))
+ (set! unique? (gnc:report-template-has-unique-name? #f unique-name))))
unique-name))
@@ -551,161 +551,167 @@
;; Generate guile code required to recreate an instatiated report
(define (gnc:report-serialize report)
- ;; clean up the options if necessary. this is only needed
- ;; in special cases.
+ ;; clean up the options if necessary. this is only needed
+ ;; in special cases.
(let* ((report-type (gnc:report-type report))
(template (hash-ref *gnc:_report-templates_* report-type))
(thunk (gnc:report-template-options-cleanup-cb template)))
- (if thunk
+ (if thunk
(thunk report)))
-
- ;; save them
- (string-append
+
+ ;; save them
+ (string-append
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
(format #f ";; options for report ~S\n" (gnc:report-name report))
(format
#f "(let ((options (gnc:report-template-new-options/report-guid ~S ~S)))\n"
- (gnc:report-type report) (gnc:report-template-name (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
+ (gnc:report-type report)
+ (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
(gnc:generate-restore-forms (gnc:report-options report) "options")
;; 2.6->2.4 compatibility code prefix
;; Temporary check to make the new report saving code more or less backwards
;; compatible with older gnucash versions. This can be removed again in 2.8.
"(if (defined? 'gnc:restore-report-by-guid-with-custom-template)\n"
;; end of 2.6->2.4 compatibility code prefix.
- (format
+ (format
#f " (gnc:restore-report-by-guid-with-custom-template ~S ~S ~S ~S options)\n"
(gnc:report-id report) (gnc:report-type report)
- (gnc:report-template-name (hash-ref *gnc:_report-templates_* (gnc:report-type report)))
+ (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* (gnc:report-type report)))
(gnc:report-custom-template report))
;; 2.6->2.4 compatibility code suffix
- (format
+ (format
#f " (gnc:restore-report-by-guid ~S ~S ~S options))\n"
(gnc:report-id report) (gnc:report-type report)
- (gnc:report-template-name (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
- ;; end of 2.6->2.4 compatibility code suffix.
- ")"
- ))
+ (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
+ ;; end of 2.6->2.4 compatibility code suffix.
+ ")"))
;; Generate guile code required to recreate embedded report instances
(define (gnc:report-serialize-embedded embedded-reports)
(let* ((result-string ""))
(if embedded-reports
- (begin
- (for-each
- (lambda (subreport-id)
- (let* (
+ (begin
+ (for-each
+ (lambda (subreport-id)
+ (let* (
(subreport (gnc-report-find subreport-id))
(subreport-type (gnc:report-type subreport))
(subreport-template (hash-ref *gnc:_report-templates_* subreport-type))
(subreport-template-name (gnc:report-template-name subreport-template))
(thunk (gnc:report-template-options-cleanup-cb subreport-template))
- )
- ;; clean up the options if necessary. this is only needed
- ;; in special cases.
- (if thunk
- (thunk subreport))
- ;; save them
- (set! result-string
- (string-append
+ )
+ ;; clean up the options if necessary. this is only needed
+ ;; in special cases.
+ (if thunk
+ (thunk subreport))
+ ;; save them
+ (set! result-string
+ (string-append
result-string
"\n ;;;; Options for embedded report\n"
" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
(format #f " ;; options for report ~S\n" (gnc:report-name subreport))
(format #f " (let ((options (gnc:report-template-new-options/report-guid ~S ~S)))"
- subreport-type
- subreport-template-name)
+ subreport-type
+ subreport-template-name)
(gnc:generate-restore-forms (gnc:report-options subreport) "options")
(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"
- subreport-type
- subreport-template-name
- (gnc:report-custom-template subreport))
+ subreport-type
+ subreport-template-name
+ (gnc:report-custom-template subreport))
" )\n"
- )
- )
+ )
+ )
+ )
+ )
+ embedded-reports)
+ ;;(set! result-string (string-append result-string (gnc:update-section-general)))
+ (set! result-string
+ (string-append
+ result-string
+ "\n"
+ " ;;;; Update Section: __general\n"
+ " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
+ " (let*\n"
+ " (\n"
+ " (option (gnc:lookup-option options \"__general\" \"report-list\"))\n"
+ " (saved-report-list (gnc:option-value option))\n"
+ " )\n"
+ " (\n"
+ " (lambda (option)\n"
+ " (if option ((gnc:option-setter option) (map (lambda (x y) (cons x (cdr y))) new-embedded-report-ids saved-report-list)))\n"
+ " )\n"
+ " option\n"
+ " )\n"
+ " )\n"
+ )
)
)
- embedded-reports)
- ;;(set! result-string (string-append result-string (gnc:update-section-general)))
- (set! result-string
- (string-append
- result-string
- "\n"
- " ;;;; Update Section: __general\n"
- " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
- " (let*\n"
- " (\n"
- " (option (gnc:lookup-option options \"__general\" \"report-list\"))\n"
- " (saved-report-list (gnc:option-value option))\n"
- " )\n"
- " (\n"
- " (lambda (option)\n"
- " (if option ((gnc:option-setter option) (map (lambda (x y) (cons x (cdr y))) new-embedded-report-ids saved-report-list)))\n"
- " )\n"
- " option\n"
- " )\n"
- " )\n"
- )
)
- )
- )
result-string
+ )
)
-)
(define (gnc:report-template-serialize-internal name type templ-name options guid)
(let* ((embedded-serialized (gnc:report-serialize-embedded (gnc:report-embedded-list options)))
- (result (string-append
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
- (format #f ";; Options for saved report ~S, based on template ~S\n"
- name type)
- (format
- #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 )"
- type templ-name)
- (gnc:generate-restore-forms options "options")
- (if embedded-serialized
- embedded-serialized
- "")
- "\n options\n )\n )\n"
- (format
- #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"
- name
- (if guid
- guid
- (guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading
- type
- type
- templ-name))))
+ (result (string-append
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
+ (format #f ";; Options for saved report ~S, based on template ~S\n"
+ name type)
+ (format
+ #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 )"
+ type templ-name)
+ (gnc:generate-restore-forms options "options")
+ (if embedded-serialized
+ embedded-serialized
+ "")
+ "\n options\n )\n )\n"
+ (format
+ #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"
+ name
+ (if guid
+ guid
+ (guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading
+ type
+ type
+ templ-name))))
(gnc:debug result)
result))
;; Convert an instantiated report into a report template
;; and generate the guile code required to recreate this template
(define (gnc:report-template-serialize-from-report report)
- ;; clean up the options if necessary. this is only needed
- ;; in special cases.
- (let* ((template
- (hash-ref *gnc:_report-templates_*
+ ;; clean up the options if necessary. this is only needed
+ ;; in special cases.
+ (let* ((template
+ (hash-ref *gnc:_report-templates_*
(gnc:report-type report)))
(thunk (gnc:report-template-options-cleanup-cb template)))
- (if thunk
+ (if thunk
(thunk report)))
-
+
;; save them
(let* ((name (gnc:report-template-make-unique-name (gnc:report-name report)))
(type (gnc:report-type report))
- (templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
+ (templ-name (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* (gnc:report-type report))))
(options (gnc:report-options report)))
(gnc:report-template-serialize-internal name type templ-name options #f)))
;; Generate guile code required to recreate a report template
-;; Note: multi column report templates encapsulate instantiated reports, not other report templates
-;; this means that the template recreation code must also contain the code to instantiate
-;; these embedded report instances. This results in a mix of template and instatiated reports
-;; in the saved reports file...
+;; Note: multi column report templates encapsulate instantiated
+;; reports, not other report templates this means that the template
+;; recreation code must also contain the code to instantiate these
+;; embedded report instances. This results in a mix of template and
+;; instatiated reports in the saved reports file...
(define (gnc:report-template-serialize report-template)
(let* ((name (gnc:report-template-name report-template))
(type (gnc:report-template-parent-type report-template))
- (templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* type)))
+ (templ-name (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* type)))
(options (gnc:report-template-new-options report-template))
(guid (gnc:report-template-report-guid report-template)))
(gnc:report-template-serialize-internal name type templ-name options guid)))
@@ -719,7 +725,9 @@
;; 2. an overwrite is requestes by setting overwrite? to #t
(define (gnc:report-to-template report overwrite?)
(let* ((custom-template-id (gnc:report-custom-template report))
- (overwrite-ok? (and (gnc:report-template-is-custom/template-guid? custom-template-id) overwrite?))
+ (overwrite-ok? (and (gnc:report-template-is-custom/template-guid?
+ custom-template-id)
+ overwrite?))
;; Generate a serialized report-template with a random guid
(saved-form (gnc:report-template-serialize-from-report report))
;; Immediately evaluate the serialized report template to
@@ -732,26 +740,26 @@
(begin
;; If it's ok to overwrite the old template, delete it now.
(if overwrite-ok?
- (let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
- ;; We're overwriting, which needs some additional steps
- ;; 1. Remove the newly generated template from the template list again
- (hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
- ;; 2. We still have the template record available though, so adapt it to
- ;; the template we want to override (ie update guid and name)
- (gnc:report-template-set-report-guid! save-result custom-template-id)
- (gnc:report-template-set-name save-result templ-name)
- ;; 3. Overwrite the template with the new one
- (hash-set! *gnc:_report-templates_* custom-template-id save-result)
- ))
+ (let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
+ ;; We're overwriting, which needs some additional steps
+ ;; 1. Remove the newly generated template from the template list again
+ (hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
+ ;; 2. We still have the template record available though, so adapt it to
+ ;; the template we want to override (ie update guid and name)
+ (gnc:report-template-set-report-guid! save-result custom-template-id)
+ (gnc:report-template-set-name save-result templ-name)
+ ;; 3. Overwrite the template with the new one
+ (hash-set! *gnc:_report-templates_* custom-template-id save-result)
+ ))
;; Regardless of how we got here, we now have a new template to write
;; so let's write it
(if (gnc:save-all-reports)
(let ((templ-guid (gnc:report-template-report-guid save-result)))
- ;; Indicate the report was instantiated from the new template
- (gnc:report-set-custom-template! report templ-guid)
- ;; Inform the calling function of the new template's guid
- templ-guid)
+ ;; Indicate the report was instantiated from the new template
+ (gnc:report-set-custom-template! report templ-guid)
+ ;; Inform the calling function of the new template's guid
+ templ-guid)
#f))
#f)))
@@ -767,23 +775,23 @@
(define (gnc:report-template-save-to-savefile report-template)
(let ((saved-form (gnc:report-template-serialize report-template)))
- (gnc-saved-reports-write-to-file saved-form #f)))
+ (gnc-saved-reports-write-to-file saved-form #f)))
;; save all custom reports, moving the old version of the
;; saved-reports file aside as a backup
;; return #t if all templates were saved successfully
(define (gnc:save-all-reports)
(let ((save-ok? #t))
- (gnc-saved-reports-backup)
- (gnc-saved-reports-write-to-file "" #t)
- (hash-for-each (lambda (k v)
- (if (gnc:report-template-parent-type v)
- (begin
- (gnc:debug "saving report " k)
- (if (not (gnc:report-template-save-to-savefile v))
- (set! save-ok? #f)
- ))))
- *gnc:_report-templates_*)
+ (gnc-saved-reports-backup)
+ (gnc-saved-reports-write-to-file "" #t)
+ (hash-for-each (lambda (k v)
+ (if (gnc:report-template-parent-type v)
+ (begin
+ (gnc:debug "saving report " k)
+ (if (not (gnc:report-template-save-to-savefile v))
+ (set! save-ok? #f)
+ ))))
+ *gnc:_report-templates_*)
save-ok?))
@@ -796,30 +804,30 @@
(define (gnc:report-render-html report headers?)
(if (and (not (gnc:report-dirty? report))
(gnc:report-ctext report))
- ;; if there's clean cached text, return it
+ ;; if there's clean cached text, return it
;;(begin
(gnc:report-ctext report)
;; )
-
- ;; otherwise, rerun the report
- (let ((template (hash-ref *gnc:_report-templates_*
+
+ ;; otherwise, rerun the report
+ (let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report)))
- (doc #f))
+ (doc #f))
(set! doc (if template
(let* ((renderer (gnc:report-template-renderer template))
(stylesheet (gnc:report-stylesheet report))
(doc (renderer report))
(html #f))
(if (string? doc)
- (set! html doc)
- (begin
- (gnc:html-document-set-style-sheet! doc stylesheet)
- (set! html (gnc:html-document-render doc headers?))))
+ (set! html doc)
+ (begin
+ (gnc:html-document-set-style-sheet! doc stylesheet)
+ (set! html (gnc:html-document-render doc headers?))))
(gnc:report-set-ctext! report html) ;; cache the html
(gnc:report-set-dirty?! report #f) ;; mark it clean
html)
#f))
- doc))) ;; YUK! inner doc is html-doc object; outer doc is a string.
+ doc))) ;; YUK! inner doc is html-doc object; outer doc is a string.
;; looks up the report by id and renders it with gnc:report-render-html
;; marks the cursor busy during rendering; returns the html
@@ -829,16 +837,16 @@
;; acceptable hack until a cleaner solution can be found (bug #704525)
(define (gnc:report-run id)
(let ((report (gnc-report-find id))
- (html #f))
+ (html #f))
(gnc-set-busy-cursor '() #t)
- (gnc:backtrace-if-exception
+ (gnc:backtrace-if-exception
(lambda ()
(if report
- (begin
- (set! html (gnc:report-render-html report #t))
+ (begin
+ (set! html (gnc:report-render-html report #t))
(set! html (gnc:substring-replace-from-to html (gnc:html-js-include "jqplot/jquery.min.js") "" 2 -1))
(set! html (gnc:substring-replace-from-to html (gnc:html-js-include "jqplot/jquery.jqplot.js") "" 2 -1))
- ))))
+ ))))
(gnc-unset-busy-cursor '())
html))
@@ -852,28 +860,28 @@
(define (gnc:report-embedded-list options)
(let* ((option (gnc:lookup-option options "__general" "report-list")))
(if option
- (let ((opt-value (gnc:option-value option)))
- (map (lambda (x) (car x)) opt-value))
- #f)))
+ (let ((opt-value (gnc:option-value option)))
+ (map (lambda (x) (car x)) opt-value))
+ #f)))
;; delete an existing report from the hash table and then call to
;; resave the saved-reports file... report is gone
(define (gnc:delete-report template-guid)
- (if (hash-ref *gnc:_report-templates_* template-guid)
- (begin
- (gnc:debug "Deleting report " template-guid)
- (hash-remove! *gnc:_report-templates_* template-guid)
- (gnc:save-all-reports))))
+ (if (hash-ref *gnc:_report-templates_* template-guid)
+ (begin
+ (gnc:debug "Deleting report " template-guid)
+ (hash-remove! *gnc:_report-templates_* template-guid)
+ (gnc:save-all-reports))))
;; rename an existing report from the hash table and then
;; resave the saved-reports file
(define (gnc:rename-report template-guid new-name)
(let ((templ (hash-ref *gnc:_report-templates_* template-guid)))
(if templ
- (begin
- (gnc:debug "Renaming report " template-guid)
- (gnc:report-template-set-name templ new-name)
- (gnc:save-all-reports)))))
+ (begin
+ (gnc:debug "Renaming report " template-guid)
+ (gnc:report-template-set-name templ new-name)
+ (gnc:save-all-reports)))))
;; Legacy functions
;;;;;;;;;;;;;;;;;;;
@@ -883,7 +891,7 @@
(define (gnc:report-template-new-options/name template-name)
(let ((templ #f))
- (hash-for-each
+ (hash-for-each
(lambda (id rec)
(if (equal? template-name (gnc:report-template-name rec))
(set! templ (hash-ref *gnc:_report-templates_* id)))) *gnc:_report-templates_*)
Summary of changes:
gnucash/report/report-system/report.scm | 917 ++++++++++-----------
.../report-system/test/test-report-system.scm | 1 +
2 files changed, 437 insertions(+), 481 deletions(-)
More information about the gnucash-changes
mailing list