r23078 - gnucash/trunk/src/report - Define 'custom-template' property on report instances (not used yet)

Geert Janssens gjanssens at code.gnucash.org
Tue Jul 2 07:17:10 EDT 2013


Author: gjanssens
Date: 2013-07-02 07:17:10 -0400 (Tue, 02 Jul 2013)
New Revision: 23078
Trac: http://svn.gnucash.org/trac/changeset/23078

Modified:
   gnucash/trunk/src/report/report-system/report-system.scm
   gnucash/trunk/src/report/report-system/report.scm
   gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm
   gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm
   gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm
Log:
Define 'custom-template' property on report instances (not used yet)

Modified: gnucash/trunk/src/report/report-system/report-system.scm
===================================================================
--- gnucash/trunk/src/report/report-system/report-system.scm	2013-07-02 11:16:59 UTC (rev 23077)
+++ gnucash/trunk/src/report/report-system/report-system.scm	2013-07-02 11:17:10 UTC (rev 23078)
@@ -150,6 +150,7 @@
 (export gnc:report-set-ctext!)
 (export gnc:make-report)
 (export gnc:restore-report-by-guid)
+(export gnc:restore-report-by-guid-with-custom-template)
 (export gnc:make-report-options)
 (export gnc:report-export-types)
 (export gnc:report-export-thunk)

Modified: gnucash/trunk/src/report/report-system/report.scm
===================================================================
--- gnucash/trunk/src/report/report-system/report.scm	2013-07-02 11:16:59 UTC (rev 23077)
+++ gnucash/trunk/src/report/report-system/report.scm	2013-07-02 11:17:10 UTC (rev 23078)
@@ -264,7 +264,7 @@
 ;; A <report> represents an instantiation of a particular report type.
 (define <report>
   (make-record-type "<report>"
-                    '(type id options dirty? needs-save? editor-widget ctext)))
+                    '(type id options dirty? needs-save? editor-widget ctext custom-template)))
 
 (define gnc:report-type 
   (record-accessor <report> 'type))
@@ -317,6 +317,12 @@
 (define gnc:report-set-ctext!
   (record-modifier <report> 'ctext))
 
+(define gnc:report-custom-template
+  (record-accessor <report> 'custom-template))
+
+(define gnc:report-set-custom-template!
+  (record-modifier <report> 'custom-template))
+
 ;; gnc:make-report instantiates a report from a report-template.
 ;; The actual report is stored away in a hash-table -- only the id is returned.
 (define (gnc:make-report template-id . rest)
@@ -324,6 +330,9 @@
 	 (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
@@ -332,6 +341,7 @@
             #f            ;; needs-save
             #f            ;; editor-widget
             #f            ;; ctext
+            custom-template ;; custom-template
             ))
         (template (hash-ref *gnc:_report-templates_* template-id))
         )
@@ -357,13 +367,23 @@
 (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)))
+		 template-id id options #t #t #f #f "")))
 	 (gnc-report-add r))
       (begin
 	(gnc-error-dialog '() (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."))
 	#f))
   )
 
+(define (gnc:restore-report-by-guid-with-custom-template id template-id template-name custom-template-id options)
+  (if options
+      (let ((r ((record-constructor <report>)
+                 template-id id options #t #t #f #f custom-template-id)))
+         (gnc-report-add r))
+      (begin
+        (gnc-error-dialog '() (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."))
+        #f))
+  )
+
 (define (gnc:make-report-options template-id)
   (let ((template (hash-ref *gnc:_report-templates_* template-id)))
     (if template
@@ -464,8 +484,11 @@
     (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")
    (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))))))
+    #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-custom-template report)
+  )))
 
 ;; Loop over embedded reports and concat result of each gnc:report-generate-restore-forms
 (define (gnc:report-generate-options-embedded report)
@@ -733,7 +756,7 @@
 (define (gnc:restore-report id template-name options)
   (if options
       (let ((r ((record-constructor <report>)
-                (gnc:report-template-name-to-id template-name) id options #t #t #f #f)))
+                (gnc:report-template-name-to-id template-name) id options #t #t #f #f "")))
            ;; Warn user (one time) we're attempting to restore old style reports
            (if (not gnc:old-style-restore-warned)
                (begin

Modified: gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm	2013-07-02 11:16:59 UTC (rev 23077)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm	2013-07-02 11:17:10 UTC (rev 23078)
@@ -51,7 +51,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
 
     (let ((doc (renderer report)))
@@ -65,7 +65,7 @@
   (let* ((income-template (gnc:find-report-template uuid))
 	 (income-options (gnc:make-report-options uuid))
 	 (income-report (constructor uuid "bar" income-options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (income-renderer (gnc:report-template-renderer income-template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -117,7 +117,7 @@
   (let* ((expense-template (gnc:find-report-template expense-report-uuid))
 	 (expense-options (gnc:make-report-options expense-report-uuid))
 	 (expense-report (constructor expense-report-uuid "bar" expense-options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (expense-renderer (gnc:report-template-renderer expense-template)))
     (let* ((env (create-test-env))
 	   (expense-accounts (env-expense-account-structure env))
@@ -180,7 +180,7 @@
     (let* ((asset-template (gnc:find-report-template uuid))
 	   (asset-options (gnc:make-report-options uuid))
 	   (asset-report (constructor uuid "bar" asset-options
-				      #t #t #f #f))
+				      #t #t #f #f ""))
 	   (asset-renderer (gnc:report-template-renderer asset-template)))
       (let* ((env (create-test-env))
 	     (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET

Modified: gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm	2013-07-02 11:16:59 UTC (rev 23077)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm	2013-07-02 11:17:10 UTC (rev 23078)
@@ -34,7 +34,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-			      #t #t #f #f))
+			      #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
 
     (let ((doc (renderer report)))
@@ -48,7 +48,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -96,7 +96,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -154,7 +154,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -210,7 +210,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -267,7 +267,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-			      #t #t #f #f))
+			      #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET

Modified: gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm	2013-07-02 11:16:59 UTC (rev 23077)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm	2013-07-02 11:17:10 UTC (rev 23078)
@@ -32,7 +32,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
 
     (let ((doc (renderer report)))
@@ -46,7 +46,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -94,7 +94,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
@@ -152,7 +152,7 @@
   (let* ((template (gnc:find-report-template uuid))
 	 (options (gnc:make-report-options uuid))
 	 (report (constructor uuid "bar" options
-				     #t #t #f #f))
+				     #t #t #f #f ""))
 	 (renderer (gnc:report-template-renderer template)))
     (let* ((env (create-test-env))
 	   (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET



More information about the gnucash-changes mailing list