gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Fri May 31 11:40:08 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/885689b4 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/6bca71f0 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/528d4b52 (commit)
	from  https://github.com/Gnucash/gnucash/commit/dfc3d274 (commit)



commit 885689b42d56d295c0354990f20d73c73ca860c8
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Wed Mar 27 19:32:22 2019 +0800

    [options] bugfix don't override inbuilt list keyword
    
    fixing a 17 year old bug.
    
    previous version had defined (save-acc list count) and (save-item list
    count) thereby overwriting the inbuilt 'list' keyword, and tried to use
    the it later on with (list key)... best rewrite with neater code.

diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 48b84e525..7c1622566 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -744,31 +744,22 @@ the option '~a'."))
      (lambda () (map convert-to-account (default-getter)))
      (gnc:restore-form-generator value->string)
      (lambda (b p)
-       (define (save-acc list count)
-         (if (not (null? list))
-             (let ((key (string-append "acc" (gnc:value->string count))))
-               (qof-book-set-option b (car list) (append p (list key)))
-               (save-acc (cdr list) (+ 1 count)))))
-
-       (if option-set
-           (begin
-             (qof-book-set-option b (length option)
-                                             (append p '("len")))
-             (save-acc option 0))))
+       (when option-set
+         (qof-book-set-option b (length option) (append p '("len")))
+         (let loop ((option option) (idx 0))
+           (unless (null? option)
+             (qof-book-set-option
+              b (car option) (append p (list (format #f "acc~a" idx))))
+             (loop (cdr option) (1+ idx))))))
      (lambda (b p)
        (let ((len (qof-book-get-option b (append p '("len")))))
-         (define (load-acc count)
-           (if (< count len)
-               (let* ((key (string-append "acc" (gnc:value->string count)))
-                      (guid (qof-book-get-option
-                             b (append p (list key)))))
-                 (cons guid (load-acc (+ count 1))))
-               '()))
-         
-         (if (and len (integer? len))
-             (begin
-               (set! option (load-acc 0))
-               (set! option-set #t)))))
+         (when (and len (integer? len))
+           (set! option
+             (map
+              (lambda (idx)
+                (qof-book-get-option b (append p (list (format #f "acc~a" idx)))))
+              (iota len)))
+           (set! option-set #t))))
      validator
      (cons multiple-selection acct-type-list) #f #f #f)))
 
@@ -1090,25 +1081,20 @@ the option '~a'."))
      (lambda () default-value)
      (gnc:restore-form-generator value->string)
      (lambda (b p)
-       (define (save-item list count)
-         (if (not (null? list))
-             (let ((key (string-append "item" (gnc:value->string count))))
-               (qof-book-set-option b (car list) (append p (list key)))
-               (save-item (cdr list) (+ 1 count)))))
        (qof-book-set-option b (length value) (append p '("len")))
-       (save-item value 0))
+       (let loop ((value value) (idx 0))
+         (unless (null? value)
+           (qof-book-set-option
+            b (caar value) (append p (list (format #f "item~a" idx))))
+           (loop (cdr value) (1+ idx)))))
      (lambda (b p)
        (let ((len (qof-book-get-option b (append p '("len")))))
-         (define (load-item count)
-           (if (< count len)
-               (let* ((key (string-append "item" (gnc:value->string count)))
-                      (val (qof-book-get-option
-                            b (append p (list key)))))
-                 (cons val (load-item (+ count 1))))
-               '()))
-
          (if (and len (integer? len))
-             (set! value (load-item 0)))))
+             (set! value
+               (map
+                (lambda (idx)
+                  (qof-book-get-option b (append p (list (format #f "item~a" idx)))))
+                (iota len))))))
      (lambda (x)
        (if (list-legal x)
            (list #t x)

commit 6bca71f03b5de484b43d77d4c21d517893830b8a
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Mar 30 20:12:20 2019 +0800

    [view-column] various modernisation fixes

diff --git a/gnucash/report/utility-reports/view-column.scm b/gnucash/report/utility-reports/view-column.scm
index 4cfdb8419..b9ab5848d 100644
--- a/gnucash/report/utility-reports/view-column.scm
+++ b/gnucash/report/utility-reports/view-column.scm
@@ -144,9 +144,7 @@
 
 	 ;; increment the alloc number for each occupied row
 	 (let loop ((row current-row-num))
-	   (let ((allocation (hash-ref column-allocs row)))
-	     (if (not allocation) 
-		 (set! allocation 0))
+	   (let ((allocation (hash-ref column-allocs row 0)))
 	     (hash-set! column-allocs row (+ colspan allocation))
 	     (if (< (+ 1 (- row current-row-num)) rowspan)
 		 (loop (+ 1 row)))))
@@ -166,16 +164,14 @@
 		 (gnc:html-markup-anchor
 		  (gnc-build-url
 		   URL-TYPE-OPTIONS
-		   (string-append "report-id=" 
-				  (format #f "~a" (car report-info)))
+		   (format #f "report-id=~a" (car report-info))
 		   "")
 		  (_ "Edit Options"))
-		 " "
+		 " "
 		 (gnc:html-markup-anchor
 		  (gnc-build-url
 		   URL-TYPE-REPORT
-		   (string-append "id=" 
-				  (format #f "~a" (car report-info)))
+		   (format #f "id=~a" (car report-info))
 		   "")
 		  (_ "Single Report")))))
 

commit 528d4b52b8d98b2ab01668138dc279c3a06fce8f
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Mar 30 20:04:41 2019 +0800

    [view-column] compact loops, eradicate set!
    
    simple modernising loops

diff --git a/gnucash/report/utility-reports/view-column.scm b/gnucash/report/utility-reports/view-column.scm
index 49a300ddd..4cfdb8419 100644
--- a/gnucash/report/utility-reports/view-column.scm
+++ b/gnucash/report/utility-reports/view-column.scm
@@ -85,24 +85,21 @@
 	 (current-row-num 0))
 
     ;; make sure each subreport has an option change callback that 
-    ;; pings the parent 
-    (let ((new-reports '()))
-      (for-each 
-       (lambda (report-info)
-	 (let ((child (car report-info))
-	       (rowspan (cadr report-info))
-	       (colspan (caddr report-info))
-	       (callback (cadddr report-info)))
-	   (if (not callback)
-	       (begin 
-		 (set! callback 
-		       (make-child-options-callback
-			report (gnc-report-find child)))
-		 (set! report-info 
-		       (list child rowspan colspan callback))))
-	   (set! new-reports (cons report-info new-reports))))
-       reports)
-      (gnc:option-set-value report-opt (reverse new-reports)))
+    ;; pings the parent
+    (let loop ((new-reports '())
+               (reports reports))
+      (if (null? reports)
+          (gnc:option-set-value report-opt (reverse new-reports))
+          (let* ((report-info (car reports))
+                 (child (car report-info))
+                 (rowspan (cadr report-info))
+                 (colspan (caddr report-info))
+                 (callback (or (cadddr report-info)
+                               (make-child-options-callback
+                                report (gnc-report-find child)))))
+            (loop (cons (list child rowspan colspan callback)
+                        new-reports)
+                  (cdr reports)))))
     
     ;; we really would rather do something smart here with the
     ;; report's cached text if possible.  For the moment, we'll have
@@ -223,19 +220,18 @@
 
 (define (cleanup-options report)
   (let* ((options (gnc:report-options report))
-	 (report-opt (gnc:lookup-option options "__general" "report-list"))
-	 (reports (gnc:option-value report-opt))
-	 (new-reports '()))
-    (for-each 
-     (lambda (report-info)
-       (let ((rep (car report-info))
-	     (rowspan (cadr report-info))
-	     (colspan (caddr report-info)))
-	 (set! report-info 
-	       (list rep rowspan colspan #f))
-	 (set! new-reports (cons report-info new-reports))))
-     reports)
-    (gnc:option-set-value report-opt (reverse new-reports))))
+	 (report-opt (gnc:lookup-option options "__general" "report-list")))
+    (let loop ((new-reports '())
+               (reports (gnc:option-value report-opt)))
+      (if (null? reports)
+          (gnc:option-set-value report-opt (reverse new-reports))
+          (let* ((report-info (car reports))
+                 (child (car report-info))
+                 (rowspan (cadr report-info))
+                 (colspan (caddr report-info)))
+            (loop (cons (list child rowspan colspan #f)
+                        new-reports)
+                  (cdr reports)))))))
 
 ;; define the view now.
 (gnc:define-report 



Summary of changes:
 gnucash/report/utility-reports/view-column.scm | 70 ++++++++++++--------------
 libgnucash/app-utils/options.scm               | 62 +++++++++--------------
 2 files changed, 55 insertions(+), 77 deletions(-)



More information about the gnucash-changes mailing list