mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[report] *delete-trailing-whitespace/reindent/untabify*
This commit is contained in:
Christopher Lam
parent
8f8f5b8461
commit
f021658382
@ -23,9 +23,8 @@
|
|||||||
(use-modules (gnucash utilities))
|
(use-modules (gnucash utilities))
|
||||||
(use-modules (gnucash app-utils))
|
(use-modules (gnucash app-utils))
|
||||||
(use-modules (gnucash gettext))
|
(use-modules (gnucash gettext))
|
||||||
(eval-when
|
(eval-when (compile load eval expand)
|
||||||
(compile load eval expand)
|
(load-extension "libgncmod-report-system" "scm_init_sw_report_system_module"))
|
||||||
(load-extension "libgncmod-report-system" "scm_init_sw_report_system_module"))
|
|
||||||
(use-modules (sw_report_system))
|
(use-modules (sw_report_system))
|
||||||
|
|
||||||
;; Terminology in this file:
|
;; Terminology in this file:
|
||||||
@ -120,78 +119,78 @@
|
|||||||
(if (null? args)
|
(if (null? args)
|
||||||
report-rec
|
report-rec
|
||||||
(let ((id (car args))
|
(let ((id (car args))
|
||||||
(value (cadr args))
|
(value (cadr args))
|
||||||
(remainder (cddr args)))
|
(remainder (cddr args)))
|
||||||
((record-modifier <report-template> id) report-rec value)
|
((record-modifier <report-template> id) report-rec value)
|
||||||
(args-to-defn report-rec remainder)))))
|
(args-to-defn report-rec remainder)))))
|
||||||
|
|
||||||
(let ((report-rec (args-to-defn #f args)))
|
(let ((report-rec (args-to-defn #f args)))
|
||||||
(if (and report-rec
|
(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))
|
(gnc:report-template-report-guid report-rec))
|
||||||
(let* ((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))
|
(name (gnc:report-template-name report-rec))
|
||||||
(tmpl (hash-ref *gnc:_report-templates_* report-guid)))
|
(tmpl (hash-ref *gnc:_report-templates_* report-guid)))
|
||||||
(if (not tmpl)
|
(if (not tmpl)
|
||||||
(hash-set! *gnc:_report-templates_*
|
(hash-set! *gnc:_report-templates_*
|
||||||
report-guid report-rec)
|
report-guid report-rec)
|
||||||
(begin
|
(begin
|
||||||
;; FIXME: We should pass the top-level window
|
;; FIXME: We should pass the top-level window
|
||||||
;; instead of the '() to gnc-error-dialog, but I
|
;; instead of the '() to gnc-error-dialog, but I
|
||||||
;; have no idea where to get it from.
|
;; have no idea where to get it from.
|
||||||
(if (gnucash-ui-is-running)
|
(if (gnucash-ui-is-running)
|
||||||
(gnc-error-dialog '() (string-append
|
(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: ")
|
(_ "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))
|
report-guid))
|
||||||
#f)
|
#f)
|
||||||
)))
|
)))
|
||||||
(begin
|
(begin
|
||||||
(if (gnc:report-template-name report-rec)
|
(if (gnc:report-template-name report-rec)
|
||||||
(begin
|
(begin
|
||||||
;; we've got an old style report with no report-id, give it an arbitrary one
|
;; 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))
|
(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 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
|
;; we'll key that from the only known good way to tie back to the original report -- the renderer
|
||||||
(hash-for-each
|
(hash-for-each
|
||||||
(lambda (id rec)
|
(lambda (id rec)
|
||||||
(if (and (equal? (gnc:report-template-renderer rec)
|
(if (and (equal? (gnc:report-template-renderer rec)
|
||||||
(gnc:report-template-renderer report-rec))
|
(gnc:report-template-renderer report-rec))
|
||||||
(not (gnc:report-template-parent-type rec)))
|
(not (gnc:report-template-parent-type rec)))
|
||||||
(begin
|
(begin
|
||||||
(gnc:warn "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
|
(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: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:debug "done setting, is now " (gnc:report-template-parent-type report-rec)))))
|
||||||
*gnc:_report-templates_*)
|
*gnc:_report-templates_*)
|
||||||
|
|
||||||
(if (gnc:report-template-parent-type report-rec)
|
(if (gnc:report-template-parent-type report-rec)
|
||||||
(begin
|
(begin
|
||||||
;; re-save this old-style report in the new format
|
;; re-save this old-style report in the new format
|
||||||
(gnc:report-template-save-to-savefile report-rec)
|
(gnc:report-template-save-to-savefile report-rec)
|
||||||
(gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
|
(gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
|
||||||
(if (not gnc:old-style-report-warned)
|
(if (not gnc:old-style-report-warned)
|
||||||
(begin
|
(begin
|
||||||
(set! gnc:old-style-report-warned #t)
|
(set! gnc:old-style-report-warned #t)
|
||||||
(if (gnucash-ui-is-running)
|
(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."))))
|
(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.")))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
|
||||||
;;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
|
#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
|
(define gnc:report-template-version
|
||||||
(record-accessor <report-template> 'version))
|
(record-accessor <report-template> 'version))
|
||||||
@ -349,24 +348,24 @@
|
|||||||
;; The actual report is stored away in a hash-table -- only the id is returned.
|
;; The actual report is stored away in a hash-table -- only the id is returned.
|
||||||
(define (gnc:make-report template-id . rest)
|
(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 (if template-parent
|
(report-type (if template-parent
|
||||||
template-parent
|
template-parent
|
||||||
template-id))
|
template-id))
|
||||||
(custom-template (if template-parent
|
(custom-template (if template-parent
|
||||||
template-id
|
template-id
|
||||||
""))
|
""))
|
||||||
(r ((record-constructor <report>)
|
(r ((record-constructor <report>)
|
||||||
report-type ;; type
|
report-type ;; type
|
||||||
#f ;; id
|
#f ;; id
|
||||||
#f ;; options
|
#f ;; options
|
||||||
#t ;; dirty
|
#t ;; dirty
|
||||||
#f ;; needs-save
|
#f ;; needs-save
|
||||||
#f ;; editor-widget
|
#f ;; editor-widget
|
||||||
#f ;; ctext
|
#f ;; ctext
|
||||||
custom-template ;; custom-template
|
custom-template ;; custom-template
|
||||||
))
|
))
|
||||||
(template (hash-ref *gnc:_report-templates_* template-id))
|
(template (hash-ref *gnc:_report-templates_* template-id))
|
||||||
)
|
)
|
||||||
(let ((options
|
(let ((options
|
||||||
(if (not (null? rest))
|
(if (not (null? rest))
|
||||||
(car rest)
|
(car rest)
|
||||||
@ -389,32 +388,33 @@
|
|||||||
(define (gnc:restore-report-by-guid id template-id template-name options)
|
(define (gnc:restore-report-by-guid id template-id template-name options)
|
||||||
(if options
|
(if options
|
||||||
(let* (
|
(let* (
|
||||||
(r ((record-constructor <report>)
|
(r ((record-constructor <report>)
|
||||||
template-id id options #t #t #f #f ""))
|
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)
|
||||||
)
|
)
|
||||||
(if (number? report-id)
|
|
||||||
(gnc:report-set-id! r report-id)
|
|
||||||
)
|
|
||||||
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.")))
|
(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-error-dialog '() errmsg)
|
||||||
(gnc:warn 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
|
(if options
|
||||||
(let* (
|
(let* (
|
||||||
(r ((record-constructor <report>)
|
(r ((record-constructor <report>)
|
||||||
template-id id options #t #t #f #f custom-template-id))
|
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
|
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.")))
|
(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.")))
|
||||||
@ -453,7 +453,7 @@
|
|||||||
(gnc:report-type report))))
|
(gnc:report-type report))))
|
||||||
(if template
|
(if template
|
||||||
(or (gnc:report-template-menu-name template)
|
(or (gnc:report-template-menu-name template)
|
||||||
(gnc:report-name report))
|
(gnc:report-name report))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(define (gnc:report-name report)
|
(define (gnc:report-name report)
|
||||||
@ -484,21 +484,21 @@
|
|||||||
;; Load and save helper functions
|
;; Load and save helper functions
|
||||||
|
|
||||||
(define (gnc:all-report-template-guids)
|
(define (gnc:all-report-template-guids)
|
||||||
(hash-fold
|
(hash-fold
|
||||||
(lambda (k v p)
|
(lambda (k v p)
|
||||||
(cons k p))
|
(cons k p))
|
||||||
'() *gnc:_report-templates_*))
|
'() *gnc:_report-templates_*))
|
||||||
|
|
||||||
;; return a list of the custom report template guids.
|
;; return a list of the custom report template guids.
|
||||||
(define (gnc:custom-report-template-guids)
|
(define (gnc:custom-report-template-guids)
|
||||||
(hash-fold
|
(hash-fold
|
||||||
(lambda (k v p)
|
(lambda (k v p)
|
||||||
(if (gnc:report-template-parent-type v)
|
(if (gnc:report-template-parent-type v)
|
||||||
(begin
|
(begin
|
||||||
(gnc:debug "template " v)
|
(gnc:debug "template " v)
|
||||||
(cons k p))
|
(cons k p))
|
||||||
p))
|
p))
|
||||||
'() *gnc:_report-templates_*))
|
'() *gnc:_report-templates_*))
|
||||||
|
|
||||||
(define (gnc:find-report-template report-type)
|
(define (gnc:find-report-template report-type)
|
||||||
(hash-ref *gnc:_report-templates_* report-type))
|
(hash-ref *gnc:_report-templates_* report-type))
|
||||||
@ -507,9 +507,9 @@
|
|||||||
(let* ((custom-template (if (string? guid) (if (string-null? guid) #f (hash-ref *gnc:_report-templates_* guid)) #f))
|
(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)))
|
(parent-type (if custom-template (gnc:report-template-parent-type custom-template) #f)))
|
||||||
|
|
||||||
(if parent-type
|
(if parent-type
|
||||||
#t
|
#t
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(define (gnc:is-custom-report-type report)
|
(define (gnc:is-custom-report-type report)
|
||||||
(gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report)))
|
(gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report)))
|
||||||
@ -521,13 +521,13 @@
|
|||||||
(let* ((unique? #t))
|
(let* ((unique? #t))
|
||||||
|
|
||||||
(if new-name
|
(if new-name
|
||||||
(hash-for-each
|
(hash-for-each
|
||||||
(lambda (id rec)
|
(lambda (id rec)
|
||||||
(if (and (not (equal? templ-guid id))
|
(if (and (not (equal? templ-guid id))
|
||||||
(gnc:report-template-is-custom/template-guid? id)
|
(gnc:report-template-is-custom/template-guid? id)
|
||||||
(equal? new-name (gnc:report-template-name rec)))
|
(equal? new-name (gnc:report-template-name rec)))
|
||||||
(set! unique? #f)))
|
(set! unique? #f)))
|
||||||
*gnc:_report-templates_*))
|
*gnc:_report-templates_*))
|
||||||
unique?))
|
unique?))
|
||||||
|
|
||||||
;; Generate a unique custom template name using the given string as a base
|
;; Generate a unique custom template name using the given string as a base
|
||||||
@ -540,9 +540,9 @@
|
|||||||
|
|
||||||
(while (not unique?)
|
(while (not unique?)
|
||||||
(begin
|
(begin
|
||||||
(set! counter (+ counter 1))
|
(set! counter (+ counter 1))
|
||||||
(set! unique-name (string-append new-name (number->string counter)))
|
(set! unique-name (string-append new-name (number->string counter)))
|
||||||
(set! unique? (gnc:report-template-has-unique-name? #f unique-name))))
|
(set! unique? (gnc:report-template-has-unique-name? #f unique-name))))
|
||||||
unique-name))
|
unique-name))
|
||||||
|
|
||||||
|
|
||||||
@ -565,7 +565,9 @@
|
|||||||
(format #f ";; options for report ~S\n" (gnc:report-name report))
|
(format #f ";; options for report ~S\n" (gnc:report-name report))
|
||||||
(format
|
(format
|
||||||
#f "(let ((options (gnc:report-template-new-options/report-guid ~S ~S)))\n"
|
#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")
|
(gnc:generate-restore-forms (gnc:report-options report) "options")
|
||||||
;; 2.6->2.4 compatibility code prefix
|
;; 2.6->2.4 compatibility code prefix
|
||||||
;; Temporary check to make the new report saving code more or less backwards
|
;; Temporary check to make the new report saving code more or less backwards
|
||||||
@ -575,106 +577,107 @@
|
|||||||
(format
|
(format
|
||||||
#f " (gnc:restore-report-by-guid-with-custom-template ~S ~S ~S ~S options)\n"
|
#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-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))
|
(gnc:report-custom-template report))
|
||||||
;; 2.6->2.4 compatibility code suffix
|
;; 2.6->2.4 compatibility code suffix
|
||||||
(format
|
(format
|
||||||
#f " (gnc:restore-report-by-guid ~S ~S ~S options))\n"
|
#f " (gnc:restore-report-by-guid ~S ~S ~S options))\n"
|
||||||
(gnc:report-id report) (gnc:report-type report)
|
(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
|
||||||
;; end of 2.6->2.4 compatibility code suffix.
|
(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
|
;; Generate guile code required to recreate embedded report instances
|
||||||
(define (gnc:report-serialize-embedded embedded-reports)
|
(define (gnc:report-serialize-embedded embedded-reports)
|
||||||
(let* ((result-string ""))
|
(let* ((result-string ""))
|
||||||
(if embedded-reports
|
(if embedded-reports
|
||||||
(begin
|
(begin
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (subreport-id)
|
(lambda (subreport-id)
|
||||||
(let* (
|
(let* (
|
||||||
(subreport (gnc-report-find subreport-id))
|
(subreport (gnc-report-find subreport-id))
|
||||||
(subreport-type (gnc:report-type subreport))
|
(subreport-type (gnc:report-type subreport))
|
||||||
(subreport-template (hash-ref *gnc:_report-templates_* subreport-type))
|
(subreport-template (hash-ref *gnc:_report-templates_* subreport-type))
|
||||||
(subreport-template-name (gnc:report-template-name subreport-template))
|
(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
|
;; clean up the options if necessary. this is only needed
|
||||||
;; in special cases.
|
;; in special cases.
|
||||||
(if thunk
|
(if thunk
|
||||||
(thunk subreport))
|
(thunk subreport))
|
||||||
;; save them
|
;; save them
|
||||||
(set! result-string
|
(set! result-string
|
||||||
(string-append
|
(string-append
|
||||||
result-string
|
result-string
|
||||||
"\n ;;;; Options for embedded report\n"
|
"\n ;;;; Options for embedded report\n"
|
||||||
" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
|
" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
|
||||||
(format #f " ;; options for report ~S\n" (gnc:report-name subreport))
|
(format #f " ;; options for report ~S\n" (gnc:report-name subreport))
|
||||||
(format #f " (let ((options (gnc:report-template-new-options/report-guid ~S ~S)))"
|
(format #f " (let ((options (gnc:report-template-new-options/report-guid ~S ~S)))"
|
||||||
subreport-type
|
subreport-type
|
||||||
subreport-template-name)
|
subreport-template-name)
|
||||||
(gnc:generate-restore-forms (gnc:report-options subreport) "options")
|
(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"
|
(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-type
|
||||||
subreport-template-name
|
subreport-template-name
|
||||||
(gnc:report-custom-template subreport))
|
(gnc:report-custom-template subreport))
|
||||||
" )\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"
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
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
|
result-string
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
|
||||||
|
|
||||||
(define (gnc:report-template-serialize-internal name type templ-name options guid)
|
(define (gnc:report-template-serialize-internal name type templ-name options guid)
|
||||||
(let* ((embedded-serialized (gnc:report-serialize-embedded (gnc:report-embedded-list options)))
|
(let* ((embedded-serialized (gnc:report-serialize-embedded (gnc:report-embedded-list options)))
|
||||||
(result (string-append
|
(result (string-append
|
||||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
|
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
|
||||||
(format #f ";; Options for saved report ~S, based on template ~S\n"
|
(format #f ";; Options for saved report ~S, based on template ~S\n"
|
||||||
name type)
|
name type)
|
||||||
(format
|
(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 )"
|
#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)
|
type templ-name)
|
||||||
(gnc:generate-restore-forms options "options")
|
(gnc:generate-restore-forms options "options")
|
||||||
(if embedded-serialized
|
(if embedded-serialized
|
||||||
embedded-serialized
|
embedded-serialized
|
||||||
"")
|
"")
|
||||||
"\n options\n )\n )\n"
|
"\n options\n )\n )\n"
|
||||||
(format
|
(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"
|
#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
|
name
|
||||||
(if guid
|
(if guid
|
||||||
guid
|
guid
|
||||||
(guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading
|
(guid-new-return)) ;; when saving a report, we need to create a guid for it for later reloading
|
||||||
type
|
type
|
||||||
type
|
type
|
||||||
templ-name))))
|
templ-name))))
|
||||||
(gnc:debug result)
|
(gnc:debug result)
|
||||||
result))
|
result))
|
||||||
|
|
||||||
@ -693,19 +696,22 @@
|
|||||||
;; save them
|
;; save them
|
||||||
(let* ((name (gnc:report-template-make-unique-name (gnc:report-name report)))
|
(let* ((name (gnc:report-template-make-unique-name (gnc:report-name report)))
|
||||||
(type (gnc:report-type 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)))
|
(options (gnc:report-options report)))
|
||||||
(gnc:report-template-serialize-internal name type templ-name options #f)))
|
(gnc:report-template-serialize-internal name type templ-name options #f)))
|
||||||
|
|
||||||
;; Generate guile code required to recreate a report template
|
;; Generate guile code required to recreate a report template
|
||||||
;; Note: multi column report templates encapsulate instantiated reports, not other report templates
|
;; Note: multi column report templates encapsulate instantiated
|
||||||
;; this means that the template recreation code must also contain the code to instantiate
|
;; reports, not other report templates this means that the template
|
||||||
;; these embedded report instances. This results in a mix of template and instatiated reports
|
;; recreation code must also contain the code to instantiate these
|
||||||
;; in the saved reports file...
|
;; 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)
|
(define (gnc:report-template-serialize report-template)
|
||||||
(let* ((name (gnc:report-template-name report-template))
|
(let* ((name (gnc:report-template-name report-template))
|
||||||
(type (gnc:report-template-parent-type 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))
|
(options (gnc:report-template-new-options report-template))
|
||||||
(guid (gnc:report-template-report-guid report-template)))
|
(guid (gnc:report-template-report-guid report-template)))
|
||||||
(gnc:report-template-serialize-internal name type templ-name options guid)))
|
(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
|
;; 2. an overwrite is requestes by setting overwrite? to #t
|
||||||
(define (gnc:report-to-template report overwrite?)
|
(define (gnc:report-to-template report overwrite?)
|
||||||
(let* ((custom-template-id (gnc:report-custom-template report))
|
(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
|
;; Generate a serialized report-template with a random guid
|
||||||
(saved-form (gnc:report-template-serialize-from-report report))
|
(saved-form (gnc:report-template-serialize-from-report report))
|
||||||
;; Immediately evaluate the serialized report template to
|
;; Immediately evaluate the serialized report template to
|
||||||
@ -732,26 +740,26 @@
|
|||||||
(begin
|
(begin
|
||||||
;; If it's ok to overwrite the old template, delete it now.
|
;; If it's ok to overwrite the old template, delete it now.
|
||||||
(if overwrite-ok?
|
(if overwrite-ok?
|
||||||
(let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
|
(let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
|
||||||
;; We're overwriting, which needs some additional steps
|
;; We're overwriting, which needs some additional steps
|
||||||
;; 1. Remove the newly generated template from the template list again
|
;; 1. Remove the newly generated template from the template list again
|
||||||
(hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
|
(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
|
;; 2. We still have the template record available though, so adapt it to
|
||||||
;; the template we want to override (ie update guid and name)
|
;; 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-report-guid! save-result custom-template-id)
|
||||||
(gnc:report-template-set-name save-result templ-name)
|
(gnc:report-template-set-name save-result templ-name)
|
||||||
;; 3. Overwrite the template with the new one
|
;; 3. Overwrite the template with the new one
|
||||||
(hash-set! *gnc:_report-templates_* custom-template-id save-result)
|
(hash-set! *gnc:_report-templates_* custom-template-id save-result)
|
||||||
))
|
))
|
||||||
|
|
||||||
;; Regardless of how we got here, we now have a new template to write
|
;; Regardless of how we got here, we now have a new template to write
|
||||||
;; so let's write it
|
;; so let's write it
|
||||||
(if (gnc:save-all-reports)
|
(if (gnc:save-all-reports)
|
||||||
(let ((templ-guid (gnc:report-template-report-guid save-result)))
|
(let ((templ-guid (gnc:report-template-report-guid save-result)))
|
||||||
;; Indicate the report was instantiated from the new template
|
;; Indicate the report was instantiated from the new template
|
||||||
(gnc:report-set-custom-template! report templ-guid)
|
(gnc:report-set-custom-template! report templ-guid)
|
||||||
;; Inform the calling function of the new template's guid
|
;; Inform the calling function of the new template's guid
|
||||||
templ-guid)
|
templ-guid)
|
||||||
#f))
|
#f))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
@ -767,23 +775,23 @@
|
|||||||
|
|
||||||
(define (gnc:report-template-save-to-savefile report-template)
|
(define (gnc:report-template-save-to-savefile report-template)
|
||||||
(let ((saved-form (gnc:report-template-serialize 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
|
;; save all custom reports, moving the old version of the
|
||||||
;; saved-reports file aside as a backup
|
;; saved-reports file aside as a backup
|
||||||
;; return #t if all templates were saved successfully
|
;; return #t if all templates were saved successfully
|
||||||
(define (gnc:save-all-reports)
|
(define (gnc:save-all-reports)
|
||||||
(let ((save-ok? #t))
|
(let ((save-ok? #t))
|
||||||
(gnc-saved-reports-backup)
|
(gnc-saved-reports-backup)
|
||||||
(gnc-saved-reports-write-to-file "" #t)
|
(gnc-saved-reports-write-to-file "" #t)
|
||||||
(hash-for-each (lambda (k v)
|
(hash-for-each (lambda (k v)
|
||||||
(if (gnc:report-template-parent-type v)
|
(if (gnc:report-template-parent-type v)
|
||||||
(begin
|
(begin
|
||||||
(gnc:debug "saving report " k)
|
(gnc:debug "saving report " k)
|
||||||
(if (not (gnc:report-template-save-to-savefile v))
|
(if (not (gnc:report-template-save-to-savefile v))
|
||||||
(set! save-ok? #f)
|
(set! save-ok? #f)
|
||||||
))))
|
))))
|
||||||
*gnc:_report-templates_*)
|
*gnc:_report-templates_*)
|
||||||
save-ok?))
|
save-ok?))
|
||||||
|
|
||||||
|
|
||||||
@ -804,22 +812,22 @@
|
|||||||
;; otherwise, rerun the report
|
;; otherwise, rerun the report
|
||||||
(let ((template (hash-ref *gnc:_report-templates_*
|
(let ((template (hash-ref *gnc:_report-templates_*
|
||||||
(gnc:report-type report)))
|
(gnc:report-type report)))
|
||||||
(doc #f))
|
(doc #f))
|
||||||
(set! doc (if template
|
(set! doc (if template
|
||||||
(let* ((renderer (gnc:report-template-renderer template))
|
(let* ((renderer (gnc:report-template-renderer template))
|
||||||
(stylesheet (gnc:report-stylesheet report))
|
(stylesheet (gnc:report-stylesheet report))
|
||||||
(doc (renderer report))
|
(doc (renderer report))
|
||||||
(html #f))
|
(html #f))
|
||||||
(if (string? doc)
|
(if (string? doc)
|
||||||
(set! html doc)
|
(set! html doc)
|
||||||
(begin
|
(begin
|
||||||
(gnc:html-document-set-style-sheet! doc stylesheet)
|
(gnc:html-document-set-style-sheet! doc stylesheet)
|
||||||
(set! html (gnc:html-document-render doc headers?))))
|
(set! html (gnc:html-document-render doc headers?))))
|
||||||
(gnc:report-set-ctext! report html) ;; cache the html
|
(gnc:report-set-ctext! report html) ;; cache the html
|
||||||
(gnc:report-set-dirty?! report #f) ;; mark it clean
|
(gnc:report-set-dirty?! report #f) ;; mark it clean
|
||||||
html)
|
html)
|
||||||
#f))
|
#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
|
;; looks up the report by id and renders it with gnc:report-render-html
|
||||||
;; marks the cursor busy during rendering; returns the 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)
|
;; acceptable hack until a cleaner solution can be found (bug #704525)
|
||||||
(define (gnc:report-run id)
|
(define (gnc:report-run id)
|
||||||
(let ((report (gnc-report-find id))
|
(let ((report (gnc-report-find id))
|
||||||
(html #f))
|
(html #f))
|
||||||
(gnc-set-busy-cursor '() #t)
|
(gnc-set-busy-cursor '() #t)
|
||||||
(gnc:backtrace-if-exception
|
(gnc:backtrace-if-exception
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(if report
|
(if report
|
||||||
(begin
|
(begin
|
||||||
(set! html (gnc:report-render-html report #t))
|
(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.min.js") "" 2 -1))
|
||||||
(set! html (gnc:substring-replace-from-to html (gnc:html-js-include "jqplot/jquery.jqplot.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 '())
|
(gnc-unset-busy-cursor '())
|
||||||
html))
|
html))
|
||||||
|
|
||||||
@ -852,28 +860,28 @@
|
|||||||
(define (gnc:report-embedded-list options)
|
(define (gnc:report-embedded-list options)
|
||||||
(let* ((option (gnc:lookup-option options "__general" "report-list")))
|
(let* ((option (gnc:lookup-option options "__general" "report-list")))
|
||||||
(if option
|
(if option
|
||||||
(let ((opt-value (gnc:option-value option)))
|
(let ((opt-value (gnc:option-value option)))
|
||||||
(map (lambda (x) (car x)) opt-value))
|
(map (lambda (x) (car x)) opt-value))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
;; delete an existing report from the hash table and then call to
|
;; delete an existing report from the hash table and then call to
|
||||||
;; resave the saved-reports file... report is gone
|
;; resave the saved-reports file... report is gone
|
||||||
(define (gnc:delete-report template-guid)
|
(define (gnc:delete-report template-guid)
|
||||||
(if (hash-ref *gnc:_report-templates_* template-guid)
|
(if (hash-ref *gnc:_report-templates_* template-guid)
|
||||||
(begin
|
(begin
|
||||||
(gnc:debug "Deleting report " template-guid)
|
(gnc:debug "Deleting report " template-guid)
|
||||||
(hash-remove! *gnc:_report-templates_* template-guid)
|
(hash-remove! *gnc:_report-templates_* template-guid)
|
||||||
(gnc:save-all-reports))))
|
(gnc:save-all-reports))))
|
||||||
|
|
||||||
;; rename an existing report from the hash table and then
|
;; rename an existing report from the hash table and then
|
||||||
;; resave the saved-reports file
|
;; resave the saved-reports file
|
||||||
(define (gnc:rename-report template-guid new-name)
|
(define (gnc:rename-report template-guid new-name)
|
||||||
(let ((templ (hash-ref *gnc:_report-templates_* template-guid)))
|
(let ((templ (hash-ref *gnc:_report-templates_* template-guid)))
|
||||||
(if templ
|
(if templ
|
||||||
(begin
|
(begin
|
||||||
(gnc:debug "Renaming report " template-guid)
|
(gnc:debug "Renaming report " template-guid)
|
||||||
(gnc:report-template-set-name templ new-name)
|
(gnc:report-template-set-name templ new-name)
|
||||||
(gnc:save-all-reports)))))
|
(gnc:save-all-reports)))))
|
||||||
|
|
||||||
;; Legacy functions
|
;; Legacy functions
|
||||||
;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user