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 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))
|
||||
(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_*)
|
||||
;; 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))
|
||||
@ -349,24 +348,24 @@
|
||||
;; 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))
|
||||
)
|
||||
(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)
|
||||
@ -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.")))
|
||||
@ -453,7 +453,7 @@
|
||||
(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)
|
||||
@ -484,21 +484,21 @@
|
||||
;; 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_*))
|
||||
(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))
|
||||
@ -507,9 +507,9 @@
|
||||
(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)))
|
||||
@ -521,13 +521,13 @@
|
||||
(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_*))
|
||||
(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))
|
||||
|
||||
|
||||
@ -565,7 +565,9 @@
|
||||
(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
|
||||
@ -575,106 +577,107 @@
|
||||
(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
|
||||
#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))))
|
||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\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))
|
||||
|
||||
@ -693,19 +696,22 @@
|
||||
;; 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?))
|
||||
|
||||
|
||||
@ -804,22 +812,22 @@
|
||||
;; 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
|
||||
(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
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user