mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[report] further refactor gnc:define-report
This commit is contained in:
parent
b8e9ce3318
commit
9dabe4a426
@ -128,54 +128,57 @@ not found.")))
|
|||||||
(modifier report-rec (cadr args))
|
(modifier report-rec (cadr args))
|
||||||
(loop report-rec (cddr args)))))))
|
(loop report-rec (cddr args)))))))
|
||||||
|
|
||||||
(let ((report-rec (args-to-defn)))
|
(let* ((report-rec (args-to-defn))
|
||||||
(if (and report-rec
|
(report-guid (gnc:report-template-report-guid report-rec))
|
||||||
;; only process reports that have a report-guid
|
(report-name (gnc:report-template-name report-rec)))
|
||||||
(gnc:report-template-report-guid report-rec))
|
(cond
|
||||||
(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
|
(report-guid
|
||||||
;; we'll key that from the only known good way to tie back to the original report -- the renderer
|
;; ideal path: report is defined, and has guid
|
||||||
(hash-for-each
|
(if (hash-ref *gnc:_report-templates_* report-guid)
|
||||||
(lambda (id rec)
|
(gui-error (string-append rpterr-dupe report-guid))
|
||||||
(if (and (equal? (gnc:report-template-renderer rec)
|
(hash-set! *gnc:_report-templates_* report-guid report-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)
|
(report-name
|
||||||
(begin
|
;; we've got an old style report with no report-guid
|
||||||
;; re-save this old-style report in the new format
|
(issue-deprecation-warning
|
||||||
(gnc:report-template-save-to-savefile report-rec)
|
"old report definition without guid is deprecated.")
|
||||||
(gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
|
|
||||||
(if (not gnc:old-style-report-warned)
|
;; give it an arbitrary one
|
||||||
(begin
|
(set! report-guid (guid-new-return))
|
||||||
(set! gnc:old-style-report-warned #t)
|
(gnc:report-template-set-report-guid! report-rec report-guid)
|
||||||
(gui-error rpterr-upgraded)
|
|
||||||
(hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec))))
|
;; we also need to give it a parent-type, so that it will
|
||||||
;;there is no parent -> this is an inital faulty report definition
|
;; restore from the open state properly we'll key that from the
|
||||||
(gui-error (string-append rpterr-guid1
|
;; only known good way to tie back to the original report -- the
|
||||||
(gnc:report-template-name report-rec)
|
;; renderer
|
||||||
rpterr-guid2)))))
|
(hash-for-each
|
||||||
#f ;; report definition is faulty: does not include name
|
(lambda (id rec)
|
||||||
;;(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
|
(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
|
(define gnc:report-template-version
|
||||||
(record-accessor <report-template> 'version))
|
(record-accessor <report-template> 'version))
|
||||||
|
Loading…
Reference in New Issue
Block a user