gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Sun Jul 12 01:15:46 EDT 2020


Updated	 via  https://github.com/Gnucash/gnucash/commit/a0c1fd61 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/353cdd45 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/f9b3b105 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/4c65e86a (commit)
	 via  https://github.com/Gnucash/gnucash/commit/d0f50b52 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/ab7e213c (commit)
	 via  https://github.com/Gnucash/gnucash/commit/7dfbc436 (commit)
	from  https://github.com/Gnucash/gnucash/commit/86f7e332 (commit)



commit a0c1fd6134f3ec95ca00e9e5792a90832bdee677
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 13:15:08 2020 +0800

    addendum to 86f7e3329

diff --git a/gnucash/gnucash-commands.cpp b/gnucash/gnucash-commands.cpp
index 7552972cf..cda95f3de 100644
--- a/gnucash/gnucash-commands.cpp
+++ b/gnucash/gnucash-commands.cpp
@@ -203,7 +203,7 @@ scm_run_report (void *data,
 
 
 struct show_report_args {
-    const std::string& show_report;
+    const std::string show_report;
 };
 
 static void

commit 353cdd45cfe98bb9db22b7f62649eedd69bf12b0
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 11:35:27 2020 +0800

    [html-text] use srfi-9 records for <html-text>

diff --git a/gnucash/report/html-text.scm b/gnucash/report/html-text.scm
index d34e2154b..94a04d420 100644
--- a/gnucash/report/html-text.scm
+++ b/gnucash/report/html-text.scm
@@ -21,6 +21,7 @@
 ;; Boston, MA  02110-1301,  USA       gnu at gnu.org
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(use-modules (srfi srfi-9))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  <html-text> class
@@ -30,35 +31,25 @@
 ;;  doc as arg to get the string out. 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define <html-text> 
-  (make-record-type "<html-text>"
-                    '(body style)))
-(define gnc:html-text? 
-  (record-predicate <html-text>))
+(define-record-type <html-text>
+  (make-html-text body style)
+  html-text?
+  (body html-text-body html-text-set-body!)
+  (style html-text-style html-text-set-style!))
 
-(define gnc:make-html-text-internal
-  (record-constructor <html-text>))
+(define gnc:html-text? html-text?)
+(define gnc:make-html-text-internal make-html-text)
+(define gnc:html-text-body html-text-body)
+(define gnc:html-text-set-body-internal! html-text-set-body!)
+(define gnc:html-text-style html-text-style)
+(define gnc:html-text-set-style-internal! html-text-set-style!)
 
 (define (gnc:make-html-text . body)
-  (gnc:make-html-text-internal 
-   body
-   (gnc:make-html-style-table)))
-
-(define gnc:html-text-body
-  (record-accessor <html-text> 'body))
-
-(define gnc:html-text-set-body-internal!
-  (record-modifier <html-text> 'body))
+  (gnc:make-html-text-internal body (gnc:make-html-style-table)))
 
 (define (gnc:html-text-set-body! txt . rest)
   (gnc:html-text-set-body-internal! txt rest))
 
-(define gnc:html-text-style
-  (record-accessor <html-text> 'style))
-
-(define gnc:html-text-set-style-internal!
-  (record-modifier <html-text> 'style))
-
 (define (gnc:html-text-set-style! text tag . rest)
   (let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest)))
                       (apply gnc:make-html-data-style-info rest)

commit f9b3b105db9b88dcff4aa9bf6707303ca2886b73
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 11:26:44 2020 +0800

    [html-table] use srfi-9 records for <html-table> and <html-table-cell>

diff --git a/gnucash/report/html-table.scm b/gnucash/report/html-table.scm
index e37ff75bb..9b9aa49d8 100644
--- a/gnucash/report/html-table.scm
+++ b/gnucash/report/html-table.scm
@@ -24,6 +24,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (use-modules (srfi srfi-2))
+(use-modules (srfi srfi-9))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 
@@ -35,29 +36,66 @@
 ;; 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define <html-table>
-  (make-record-type "<html-table>"
-                    '(col-headers
-                      row-headers
-                      caption 
-                      data
-		      num-rows
-                      style
-                      col-styles
-                      row-styles
-                      row-markup-table
-                      col-headers-style
-                      row-headers-style)))
-
-(define gnc:html-table? 
-  (record-predicate <html-table>))
-
-(define <html-table-cell>
-  (make-record-type "<html-table-cell>"
-                    '(rowspan colspan tag data style)))
-
-(define gnc:make-html-table-cell-internal
-  (record-constructor <html-table-cell>))
+(define-record-type <html-table>
+  (make-html-table col-headers row-headers caption data num-rows style
+                   col-styles row-styles row-markup-table col-headers-style
+                   row-headers-style)
+  html-table?
+  (col-headers html-table-col-headers html-table-set-col-headers!)
+  (row-headers html-table-row-headers html-table-set-row-headers!)
+  (caption html-table-caption html-table-set-caption!)
+  (data html-table-data html-table-set-data!)
+  (num-rows html-table-num-rows html-table-set-num-rows!)
+  (style html-table-style html-table-set-style!)
+  (col-styles html-table-col-styles html-table-set-col-styles!)
+  (row-styles html-table-row-styles html-table-set-row-styles!)
+  (row-markup-table html-table-row-markup-table html-table-set-row-markup-table!)
+  (col-headers-style html-table-col-headers-style)
+  (row-headers-style html-table-row-headers-style))
+
+(define gnc:html-table? html-table?)
+(define gnc:make-html-table-internal make-html-table)
+(define gnc:html-table-data html-table-data)
+(define gnc:html-table-set-data! html-table-set-data!)
+(define gnc:html-table-caption html-table-caption)
+(define gnc:html-table-set-caption! html-table-set-caption!)
+(define gnc:html-table-multirow-col-headers html-table-col-headers)
+(define gnc:html-table-set-multirow-col-headers! html-table-set-col-headers!)
+(define gnc:html-table-style html-table-style)
+(define gnc:html-table-set-style-internal! html-table-set-style!)
+(define gnc:html-table-row-styles html-table-row-styles)
+(define gnc:html-table-set-row-styles! html-table-set-row-styles!)
+(define gnc:html-table-row-markup-table html-table-row-markup-table)
+(define gnc:html-table-set-row-markup-table! html-table-set-row-markup-table!)
+(define gnc:html-table-col-styles html-table-col-styles)
+(define gnc:html-table-set-col-styles! html-table-set-col-styles!)
+(define gnc:html-table-col-headers-style html-table-col-headers-style)
+(define gnc:html-table-row-headers-style html-table-row-headers-style)
+(define gnc:html-table-num-rows html-table-num-rows)
+(define gnc:html-table-set-num-rows-internal! html-table-set-num-rows!)
+
+
+(define-record-type <html-table-cell>
+  (make-html-table-cell rowspan colspan tag data style)
+  html-table-cell?
+  (rowspan html-table-rowspan html-table-set-rowspan!)
+  (colspan html-table-colspan html-table-set-colspan!)
+  (tag html-table-tag html-table-set-tag!)
+  (data html-table-data html-table-set-data!)
+  (style html-table-style html-table-set-style!))
+
+(define gnc:make-html-table-cell-internal make-html-table-cell)
+(define gnc:html-table-cell? html-table-cell?)
+(define gnc:html-table-cell-rowspan html-table-rowspan)
+(define gnc:html-table-cell-set-rowspan! html-table-set-rowspan!)
+(define gnc:html-table-cell-colspan html-table-colspan)
+(define gnc:html-table-cell-set-colspan! html-table-set-colspan!)
+(define gnc:html-table-cell-tag html-table-tag)
+(define gnc:html-table-cell-set-tag! html-table-set-tag!)
+(define gnc:html-table-cell-data html-table-data)
+(define gnc:html-table-cell-set-data-internal! html-table-set-data!)
+(define gnc:html-table-cell-style html-table-style)
+(define gnc:html-table-cell-set-style-internal! html-table-set-style!)
 
 (define (gnc:make-html-table-cell . objects)
   (gnc:make-html-table-cell-internal 1 1 "td" objects 
@@ -93,39 +131,6 @@
   (gnc:make-html-table-cell-internal rowspan colspan "th"
                                      objects (gnc:make-html-style-table)))
 
-(define gnc:html-table-cell? 
-  (record-predicate <html-table-cell>))
-
-(define gnc:html-table-cell-rowspan
-  (record-accessor <html-table-cell> 'rowspan))
-
-(define gnc:html-table-cell-set-rowspan!
-  (record-modifier <html-table-cell> 'rowspan))
-
-(define gnc:html-table-cell-colspan
-  (record-accessor <html-table-cell> 'colspan))
-
-(define gnc:html-table-cell-set-colspan!
-  (record-modifier <html-table-cell> 'colspan))
-
-(define gnc:html-table-cell-tag
-  (record-accessor <html-table-cell> 'tag))
-
-(define gnc:html-table-cell-set-tag!
-  (record-modifier <html-table-cell> 'tag))
-
-(define gnc:html-table-cell-data
-  (record-accessor <html-table-cell> 'data))
-
-(define gnc:html-table-cell-set-data-internal!
-  (record-modifier <html-table-cell> 'data))
-
-(define gnc:html-table-cell-style
-  (record-accessor <html-table-cell> 'style))
-
-(define gnc:html-table-cell-set-style-internal!
-  (record-modifier <html-table-cell> 'style))
-
 (define (gnc:html-table-cell-set-style! cell tag . rest)
   (let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest)))
                       (apply gnc:make-html-data-style-info rest)
@@ -174,9 +179,6 @@
 ;;  wrapper around HTML tables
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define gnc:make-html-table-internal
-  (record-constructor <html-table>))
-
 (define (gnc:make-html-table)
   (gnc:make-html-table-internal 
    #f                    ;; col-headers 
@@ -192,60 +194,16 @@
    (gnc:make-html-style-table) ;; row-headers-style
    ))
 
-(define gnc:html-table-data
-  (record-accessor <html-table> 'data))
-
-(define gnc:html-table-set-data!
-  (record-modifier <html-table> 'data))
-
-(define gnc:html-table-caption
-  (record-accessor <html-table> 'caption))
-
-(define gnc:html-table-set-caption!
-  (record-modifier <html-table> 'caption))
 
 (define (gnc:html-table-set-col-headers! table col-headers)
   (gnc:html-table-set-multirow-col-headers! table (list col-headers)))
 
-(define gnc:html-table-multirow-col-headers
-  (record-accessor <html-table> 'col-headers))
-
-(define gnc:html-table-set-multirow-col-headers!
-  (record-modifier <html-table> 'col-headers))
-
-(define gnc:html-table-style
-  (record-accessor <html-table> 'style))
-
-(define gnc:html-table-set-style-internal!
-  (record-modifier <html-table> 'style))
-
-(define gnc:html-table-row-styles
-  (record-accessor <html-table> 'row-styles))
-
-(define gnc:html-table-set-row-styles!
-  (record-modifier <html-table> 'row-styles))
-
-(define gnc:html-table-row-markup-table
-  (record-accessor <html-table> 'row-markup-table))
-
 (define (gnc:html-table-row-markup table row)
   (hash-ref (gnc:html-table-row-markup-table table) row))
 
-(define gnc:html-table-set-row-markup-table!
-  (record-modifier <html-table> 'row-markup-table))
-
 (define (gnc:html-table-set-row-markup! table row markup)
   (hash-set! (gnc:html-table-row-markup-table table) row markup))
 
-(define gnc:html-table-col-styles
-  (record-accessor <html-table> 'col-styles))
-
-(define gnc:html-table-set-col-styles!
-  (record-modifier <html-table> 'col-styles))
-
-(define gnc:html-table-col-headers-style
-  (record-accessor <html-table> 'col-headers-style))
-
 (define (gnc:html-table-set-col-headers-style! table tag . rest)
   (let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest)))
                       (apply gnc:make-html-data-style-info rest)
@@ -253,8 +211,6 @@
         (style (gnc:html-table-col-headers-style table)))
     (gnc:html-style-table-set! style tag newstyle)))
 
-(define gnc:html-table-row-headers-style
-  (record-accessor <html-table> 'row-headers-style))
 
 (define (gnc:html-table-set-row-headers-style! table tag . rest)
   (let* ((newstyle (if (and (= (length rest) 2) (procedure? (car rest)))
@@ -298,12 +254,6 @@
 (define (gnc:html-table-col-style table col)
   (hash-ref (gnc:html-table-col-styles table) col))
 
-(define gnc:html-table-num-rows
- (record-accessor <html-table> 'num-rows))
-
-(define gnc:html-table-set-num-rows-internal!
-  (record-modifier <html-table> 'num-rows))
-
 (define (gnc:html-table-num-columns table)
   (apply max (cons 0 (map length (gnc:html-table-data table)))))
 

commit 4c65e86a4a1d1c59d9ab2567816bf534618d97d1
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 11:35:16 2020 +0800

    [html-anytag] use srfi-9 records for <html-anytag>

diff --git a/gnucash/report/html-anytag.scm b/gnucash/report/html-anytag.scm
index 879fe1dda..fc2475d3a 100644
--- a/gnucash/report/html-anytag.scm
+++ b/gnucash/report/html-anytag.scm
@@ -24,48 +24,31 @@
 ;; Boston, MA  02110-1301,  USA       gnu at gnu.org
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define <html-anytag>
-  (make-record-type "<html-anytag>"
-                    '(tag
-                      data
-                      style
-                      )))
-
-(define gnc:html-anytag?
-  (record-predicate <html-anytag>))
+(use-modules (srfi srfi-9))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  <html-anytag> class
 ;;  wrapper around HTML anytags
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define gnc:make-html-anytag-internal
-  (record-constructor <html-anytag>))
+(define-record-type <html-anytag>
+  (make-html-anytag tag data style)
+  html-anytag?
+  (tag html-anytag-tag html-anytag-set-tag!)
+  (data html-anytag-data html-anytag-set-data!)
+  (style html-anytag-style html-anytag-set-style!))
+
+(define gnc:html-anytag? html-anytag?)
+(define gnc:make-html-anytag-internal make-html-anytag)
+(define gnc:html-anytag-tag html-anytag-tag)
+(define gnc:html-anytag-set-tag! html-anytag-set-tag!)
+(define gnc:html-anytag-data html-anytag-data)
+(define gnc:html-anytag-set-data! html-anytag-set-data!)
+(define gnc:html-anytag-style html-anytag-style)
+(define gnc:html-anytag-set-style-internal! html-anytag-set-style!)
 
 (define (gnc:make-html-anytag tag . data)
-  (gnc:make-html-anytag-internal
-   tag                         ;; tag
-   data                        ;; data
-   (gnc:make-html-style-table) ;; style
-   ))
-
-(define gnc:html-anytag-tag
-  (record-accessor <html-anytag> 'tag))
-
-(define gnc:html-anytag-set-tag!
-  (record-modifier <html-anytag> 'tag))
-
-(define gnc:html-anytag-data
-  (record-accessor <html-anytag> 'data))
-
-(define gnc:html-anytag-set-data!
-  (record-modifier <html-anytag> 'data))
-
-(define gnc:html-anytag-style
-  (record-accessor <html-anytag> 'style))
-
-(define gnc:html-anytag-set-style-internal!
-  (record-modifier <html-anytag> 'style))
+  (gnc:make-html-anytag-internal tag data (gnc:make-html-style-table)))
 
 (define (gnc:html-anytag-append-data! anytag . data)
   (gnc:html-anytag-set-data!
@@ -114,8 +97,10 @@
                                 'attribute (list "class" class))
     anytag))
 
-(define (gnc:make-html-div . data)                 ;ideally should have been (gnc:make-html-anytag "div" data) but it will inherit parent div class.
-  (apply gnc:make-html-div/markup (cons "" data))) ;so we have to redo as an empty-string. so annoying!
+;;ideally should have been (gnc:make-html-anytag "div" data) but it
+;;will inherit parent div class.
+(define (gnc:make-html-div . data)
+  (apply gnc:make-html-div/markup (cons "" data)))
 
 (define (gnc:make-html-span . data)
   (apply gnc:make-html-span/markup (cons "" data)))

commit d0f50b52281c235d0d697d980f55bf72fd7d8a0b
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 12:36:46 2020 +0800

    [html-style-sheet] combine 2 similar functions

diff --git a/gnucash/report/html-style-sheet.scm b/gnucash/report/html-style-sheet.scm
index 5fb0b1a67..6af6ea150 100644
--- a/gnucash/report/html-style-sheet.scm
+++ b/gnucash/report/html-style-sheet.scm
@@ -124,65 +124,31 @@
        (apply gnc:make-html-data-style-info rest)
        (apply gnc:make-html-markup-style-info rest))))
 
+(define (make-html-style-sheet-internal template-name style-sheet-name options)
+  (define template (gnc:html-style-sheet-template-find template-name))
+  (define fallback-styles
+    (list (cons "<string>" gnc:default-html-string-renderer)
+          (cons "<gnc-numeric>" gnc:default-html-gnc-numeric-renderer)
+          (cons "<number>" gnc:default-html-number-renderer)
+          (cons "<gnc-monetary>" gnc:default-html-gnc-monetary-renderer)))
+  (and template
+       (let ((ss (gnc:make-html-style-sheet-internal
+                  style-sheet-name template-name
+                  (or options
+                      ((gnc:html-style-sheet-template-options-generator template)))
+                  (gnc:html-style-sheet-template-renderer template)
+                  (gnc:make-html-style-table))))
+         (for-each (lambda (pair)
+                     (gnc:html-style-sheet-set-style! ss (car pair) (cdr pair) #f))
+                   fallback-styles)
+         (hash-set! *gnc:_style-sheets_* style-sheet-name ss)
+         ss)))
+
 (define (gnc:make-html-style-sheet template-name style-sheet-name)
-  (let* ((template (gnc:html-style-sheet-template-find template-name)))
-    (if template
-        (let ((rv (gnc:make-html-style-sheet-internal 
-                   style-sheet-name template-name 
-                   ((gnc:html-style-sheet-template-options-generator template))
-                   (gnc:html-style-sheet-template-renderer template)
-                   (gnc:make-html-style-table))))
-          ;; set up the fallback data styles for every rendered document 
-          (gnc:html-style-sheet-set-style! 
-           rv "<string>" 
-           gnc:default-html-string-renderer #f)
-          
-          (gnc:html-style-sheet-set-style! 
-           rv "<gnc-numeric>" 
-           gnc:default-html-gnc-numeric-renderer #f)
-          
-          (gnc:html-style-sheet-set-style!
-           rv "<number>" 
-           gnc:default-html-number-renderer #f)
-          
-          (gnc:html-style-sheet-set-style!
-           rv "<gnc-monetary>" 
-           gnc:default-html-gnc-monetary-renderer #f)
-
-          ;; store it in the style sheet hash 
-          (hash-set! *gnc:_style-sheets_* style-sheet-name rv)
-          rv)
-        #f)))
+  (make-html-style-sheet-internal template-name style-sheet-name #f))
 
 (define (gnc:restore-html-style-sheet style-sheet-name template-name options)
-  (let* ((template (gnc:html-style-sheet-template-find template-name)))
-    (if template
-        (let ((rv (gnc:make-html-style-sheet-internal 
-                   style-sheet-name template-name 
-                   options
-                   (gnc:html-style-sheet-template-renderer template)
-                   (gnc:make-html-style-table))))
-          ;; set up the fallback data styles for every rendered document 
-          (gnc:html-style-sheet-set-style! 
-           rv "<string>" 
-           gnc:default-html-string-renderer #f)
-          
-          (gnc:html-style-sheet-set-style! 
-           rv "<gnc-numeric>" 
-           gnc:default-html-gnc-numeric-renderer #f)
-          
-          (gnc:html-style-sheet-set-style!
-           rv "<number>" 
-           gnc:default-html-number-renderer #f)
-          
-          (gnc:html-style-sheet-set-style!
-           rv "<gnc-monetary>" 
-           gnc:default-html-gnc-monetary-renderer #f)
-          
-          ;; store it in the style sheet hash 
-          (hash-set! *gnc:_style-sheets_* style-sheet-name rv)
-          rv)
-        #f)))
+  (make-html-style-sheet-internal template-name style-sheet-name options))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

commit ab7e213c309f8ea8d5d44b8a7d09e67d738aafbf
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 11:49:16 2020 +0800

    [html-style-sheet] use srfi-9 records for <html-style-sheet-template> and <html-style-sheet>

diff --git a/gnucash/report/html-style-sheet.scm b/gnucash/report/html-style-sheet.scm
index 9a05c3116..5fb0b1a67 100644
--- a/gnucash/report/html-style-sheet.scm
+++ b/gnucash/report/html-style-sheet.scm
@@ -21,42 +21,30 @@
 ;; Boston, MA  02110-1301,  USA       gnu at gnu.org
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(use-modules (srfi srfi-9))
 (use-modules (ice-9 match))
 (use-modules (gnucash core-utils))
 
 (define *gnc:_style-sheet-templates_* (make-hash-table 23))
 (define *gnc:_style-sheets_* (make-hash-table 23))
 
-(define <html-style-sheet-template> 
-  (make-record-type "<html-style-sheet-template>" 
-                    '(version name options-generator renderer)))
-
-(define gnc:html-style-sheet-template? 
-  (record-predicate <html-style-sheet-template>))
-
-(define gnc:html-style-sheet-template-version
-  (record-accessor <html-style-sheet-template> 'version))
-
-(define gnc:html-style-sheet-template-set-version!
-  (record-modifier <html-style-sheet-template> 'version))
-
-(define gnc:html-style-sheet-template-name
-  (record-accessor <html-style-sheet-template> 'name))
-
-(define gnc:html-style-sheet-template-set-name!
-  (record-modifier <html-style-sheet-template> 'name))
-
-(define gnc:html-style-sheet-template-options-generator
-  (record-accessor <html-style-sheet-template> 'options-generator))
-
-(define gnc:html-style-sheet-template-set-options-generator!
-  (record-modifier <html-style-sheet-template> 'options-generator))
-
-(define gnc:html-style-sheet-template-renderer
-  (record-accessor <html-style-sheet-template> 'renderer))
-
-(define gnc:html-style-sheet-template-set-renderer!
-  (record-modifier <html-style-sheet-template> 'renderer))
+(define-record-type <html-style-sheet-template>
+  (make-ss-template version name options-generator renderer)
+  ss-template?
+  (version ss-template-version ss-template-set-version!)
+  (name ss-template-name ss-template-set-name!)
+  (options-generator ss-template-options-generator ss-template-set-options-generator!)
+  (renderer ss-template-renderer ss-template-set-renderer!))
+
+(define gnc:html-style-sheet-template? ss-template?)
+(define gnc:html-style-sheet-template-version ss-template-version)
+(define gnc:html-style-sheet-template-set-version! ss-template-set-version!)
+(define gnc:html-style-sheet-template-name ss-template-name)
+(define gnc:html-style-sheet-template-set-name! ss-template-set-name!)
+(define gnc:html-style-sheet-template-options-generator ss-template-options-generator)
+(define gnc:html-style-sheet-template-set-options-generator! ss-template-set-options-generator!)
+(define gnc:html-style-sheet-template-renderer ss-template-renderer)
+(define gnc:html-style-sheet-template-set-renderer! ss-template-set-renderer!)
 
 (define (gnc:html-style-sheet-template-find tname)
   (hash-ref *gnc:_style-sheet-templates_* tname))
@@ -68,56 +56,38 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (gnc:define-html-style-sheet . args)
-  (let loop ((args args)
-             (ss ((record-constructor <html-style-sheet-template>) #f #f #f #f)))
+  (let loop ((args args) (ss (make-ss-template #f #f #f #f)))
     (match args
       ((field value . rest)
        ((record-modifier <html-style-sheet-template> field) ss value)
        (loop rest ss))
-      (else ;; store the style sheet template
-       (hash-set! *gnc:_style-sheet-templates_*
-                  (gnc:html-style-sheet-template-name ss) ss)))))
+      (_ (hash-set! *gnc:_style-sheet-templates_*
+                    (gnc:html-style-sheet-template-name ss) ss)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; <html-style-sheet> methods 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define <html-style-sheet> 
-  (make-record-type "<html-style-sheet>" 
-                    '(name type options renderer style)))
-
-(define gnc:html-style-sheet? 
-  (record-predicate <html-style-sheet>))
-
-(define gnc:html-style-sheet-name
-  (record-accessor <html-style-sheet> 'name))
-
-(define gnc:html-style-sheet-set-name!
-  (record-modifier <html-style-sheet> 'name))
-
-(define gnc:html-style-sheet-type
-  (record-accessor <html-style-sheet> 'type))
-
-(define gnc:html-style-sheet-set-type!
-  (record-modifier <html-style-sheet> 'type))
-
-(define gnc:html-style-sheet-options
-  (record-accessor <html-style-sheet> 'options))
-
-(define gnc:html-style-sheet-set-options!
-  (record-modifier <html-style-sheet> 'options))
-
-(define gnc:html-style-sheet-renderer
-  (record-accessor <html-style-sheet> 'renderer))
-
-(define gnc:html-style-sheet-set-renderer!
-  (record-modifier <html-style-sheet> 'renderer))
-
-(define gnc:make-html-style-sheet-internal
-  (record-constructor <html-style-sheet>))
-
-(define gnc:html-style-sheet-style
-  (record-accessor <html-style-sheet> 'style))
+(define-record-type <html-style-sheet>
+  (make-html-ss name type options renderer style)
+  html-ss?
+  (name ss-name ss-set-name!)
+  (type ss-type ss-set-type!)
+  (options ss-options ss-set-options!)
+  (renderer ss-renderer ss-set-renderer!)
+  (style ss-style))
+
+(define gnc:make-html-style-sheet-internal make-html-ss)
+(define gnc:html-style-sheet? html-ss?)
+(define gnc:html-style-sheet-name ss-name)
+(define gnc:html-style-sheet-set-name! ss-set-name!)
+(define gnc:html-style-sheet-type ss-type)
+(define gnc:html-style-sheet-set-type! ss-set-type!)
+(define gnc:html-style-sheet-options ss-options)
+(define gnc:html-style-sheet-set-options! ss-set-options!)
+(define gnc:html-style-sheet-renderer ss-renderer)
+(define gnc:html-style-sheet-set-renderer! ss-set-renderer!)
+(define gnc:html-style-sheet-style ss-style)
 
 (define gnc:current-saved-stylesheets
   (gnc-build-userdata-path "stylesheets-2.0"))

commit 7dfbc436b982d1c64549593f1efae54c3ca725f0
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 12 11:27:06 2020 +0800

    [html-style-info] use srfi-9 records for <html-style-table>

diff --git a/gnucash/report/html-style-info.scm b/gnucash/report/html-style-info.scm
index 8975e7aa0..6ec971f04 100644
--- a/gnucash/report/html-style-info.scm
+++ b/gnucash/report/html-style-info.scm
@@ -188,37 +188,24 @@
 ;; deserves a record structure. 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define <html-style-table>
-  (make-record-type "<html-style-table>"
-                    '(primary compiled inheritable)))
-
-(define gnc:html-style-table? 
-  (record-predicate <html-style-table>))
-
-(define gnc:make-html-style-table-internal 
-  (record-constructor <html-style-table>))
-
+(define-record-type <html-style-table>
+  (make-html-style-table primary compiled inheritable)
+  html-style-table?
+  (primary html-style-table-primary)
+  (compiled html-style-table-compiled html-style-table-set-compiled!)
+  (inheritable html-style-table-inheritable html-style-table-set-inheritable!))
+
+(define gnc:html-style-table? html-style-table?)
+(define gnc:make-html-style-table-internal make-html-style-table)
+(define gnc:html-style-table-primary html-style-table-primary)
+(define gnc:html-style-table-set-compiled! html-style-table-set-compiled!)
+(define gnc:html-style-table-inheritable html-style-table-inheritable)
+(define gnc:html-style-table-set-inheritable! html-style-table-set-inheritable!)
+(define gnc:html-style-table-compiled html-style-table-compiled)
+(define gnc:html-style-table-compiled? gnc:html-style-table-compiled)
 (define (gnc:make-html-style-table)
   (gnc:make-html-style-table-internal (make-hash-table) #f #f))
 
-(define gnc:html-style-table-primary
-  (record-accessor <html-style-table> 'primary))
-
-(define gnc:html-style-table-compiled
-  (record-accessor <html-style-table> 'compiled))
-
-(define gnc:html-style-table-set-compiled!
-  (record-modifier <html-style-table> 'compiled))
-
-(define gnc:html-style-table-inheritable
-  (record-accessor <html-style-table> 'inheritable))
-
-(define gnc:html-style-table-set-inheritable!
-  (record-modifier <html-style-table> 'inheritable))
-
-(define (gnc:html-style-table-compiled? table)
-  (gnc:html-style-table-compiled table))
-
 (define (gnc:html-style-table-compile table antecedents)
   ;; merge a key-value pair from an antecedent into the 
   ;; compiled table.  Only add values to the inheritable table



Summary of changes:
 gnucash/gnucash-commands.cpp        |   2 +-
 gnucash/report/html-anytag.scm      |  57 ++++-------
 gnucash/report/html-style-info.scm  |  43 +++-----
 gnucash/report/html-style-sheet.scm | 190 ++++++++++++------------------------
 gnucash/report/html-table.scm       | 172 ++++++++++++--------------------
 gnucash/report/html-text.scm        |  35 +++----
 6 files changed, 174 insertions(+), 325 deletions(-)



More information about the gnucash-changes mailing list