From f021658382b6b26a83dc1884c30529c39f7c84b6 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 Jan 2019 17:52:27 +0800 Subject: [PATCH] [report] *delete-trailing-whitespace/reindent/untabify* --- gnucash/report/report-system/report.scm | 588 ++++++++++++------------ 1 file changed, 298 insertions(+), 290 deletions(-) diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm index bace494d64..e64aa3c5b8 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 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 '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 "" '(type id options dirty? needs-save? editor-widget ctext custom-template))) -(define gnc:report-type +(define gnc:report-type (record-accessor 'type)) (define gnc:report-set-type! (record-modifier 'type)) -(define gnc:report-id +(define gnc:report-id (record-accessor 'id)) (define gnc:report-set-id! (record-modifier 'id)) -(define gnc:report-options +(define gnc:report-options (record-accessor 'options)) (define gnc:report-set-options! (record-modifier 'options)) -(define gnc:report-needs-save? +(define gnc:report-needs-save? (record-accessor 'needs-save?)) (define gnc:report-set-needs-save?! (record-modifier 'needs-save?)) -(define gnc:report-dirty? +(define gnc:report-dirty? (record-accessor '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 'editor-widget)) (define gnc:report-set-editor-widget! (record-modifier 'editor-widget)) ;; ctext is for caching the rendered html -(define gnc:report-ctext +(define gnc:report-ctext (record-accessor '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-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-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 ) - template-id id options #t #t #f #f "")) - (report-id (gnc-report-add r)) + (r ((record-constructor ) + 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 ) + (r ((record-constructor ) 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_*)) + (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) +(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_*)