gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Wed Feb 20 10:00:15 EST 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/b334366f (commit)
	 via  https://github.com/Gnucash/gnucash/commit/25f2abb0 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/fe6cc534 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/97256242 (commit)
	from  https://github.com/Gnucash/gnucash/commit/9ba0d965 (commit)



commit b334366f6329456df9b32ac253c523bb56032490
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Feb 12 09:01:40 2019 +0800

    [html-document] if headers? is #f, do not add <body> tag
    
    This is a step towards creating valid html in multiple-charts reports.

diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index 4d870c117..e678a073e 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -146,25 +146,24 @@
           ;; push it
           (gnc:html-document-push-style doc (gnc:html-document-style doc))
           (gnc:report-render-starting (gnc:html-document-title doc))
-          (if headers?
-              (begin
-                ;;This is the only place where <html> appears
-                ;;with the exception of 2 reports:
-                ;;./share/gnucash/scm/gnucash/report/taxinvoice.eguile.scm:<html>
-                ;;./share/gnucash/scm/gnucash/report/balsheet-eg.eguile.scm:<html>
-
-                (push "<html>\n")
-                (push "<head>\n")
-                (push "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n")
-                (if style-text
-                    (push (list "</style>" style-text "<style type=\"text/css\">\n")))
-                (if (not (string-null? title))
-                    (push (list "</title>" title "<title>\n")))
-                (push "</head>")))
-                
-          ;; this lovely little number just makes sure that <body>
-          ;; attributes like bgcolor get included
-          (push ((gnc:html-markup/open-tag-only "body") doc))
+          (when headers?
+            ;;This is the only place where <html> appears
+            ;;with the exception of 2 reports:
+            ;;./share/gnucash/scm/gnucash/report/taxinvoice.eguile.scm:<html>
+            ;;./share/gnucash/scm/gnucash/report/balsheet-eg.eguile.scm:<html>
+
+            (push "<html>\n")
+            (push "<head>\n")
+            (push "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n")
+            (if style-text
+                (push (list "</style>" style-text "<style type=\"text/css\">\n")))
+            (if (not (string-null? title))
+                (push (list "</title>" title "<title>\n")))
+            (push "</head>")
+
+            ;; this lovely little number just makes sure that <body>
+            ;; attributes like bgcolor get included
+            (push ((gnc:html-markup/open-tag-only "body") doc)))
 
           ;; now render the children
           (for-each
@@ -174,10 +173,9 @@
                (gnc:report-percent-done (* 100 (/ work-done work-to-do))))
            objs)
 
-          (push "</body>\n")
-
-          (if headers?
-                (push "</html>\n"))
+          (when headers?
+            (push "</body>\n")
+            (push "</html>\n"))
 
           (gnc:report-finished)
           (gnc:html-document-pop-style doc)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 345bf8e30..966a63da3 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -26,8 +26,7 @@
 <meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
 </head><body>")
 
-(define html-doc-no-header-empty-body
-"<body></body>\n")
+(define html-doc-no-header-empty-body "")
 
 (define html-doc-tail
 "</body>\n\

commit 25f2abb01123801f3e3b7136df788a39732e9ba4
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Feb 12 08:57:55 2019 +0800

    [html-document] compact functions
    
    These functions were unnecessarily complex and used to build html
    report. Tests are not mandatory here... All tests still pass which
    means the html-documents are being built up correctly.

diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index f7a3d3920..4d870c117 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -109,19 +109,17 @@
 
 (define (gnc:html-document-tree-collapse tree)
   (let ((retval '()))
-    (define (do-list list)
+    (let loop ((lst tree))
       (for-each
        (lambda (elt)
-         (if (string? elt)
-             (set! retval (cons elt retval))
-             (if (not (list? elt))
-                 (set! retval
-                       (cons (with-output-to-string
-                               (lambda () (display elt)))
-                             retval))
-                 (do-list elt))))
-       list))
-    (do-list tree)
+         (cond
+          ((string? elt)
+           (set! retval (cons elt retval)))
+          ((not (list? elt))
+           (set! retval (cons (object->string elt) retval)))
+          (else
+           (loop elt))))
+       lst))
     retval))
 
 ;; first optional argument is "headers?"
@@ -247,10 +245,7 @@
 
 (define (gnc:html-document-markup-start doc markup end-tag? . rest)
   (let ((childinfo (gnc:html-document-fetch-markup-style doc markup))
-        (extra-attrib
-         (if (not (null? rest))
-             rest #f))
-        (show-result #f))
+        (extra-attrib (and (pair? rest) rest)))
     ;; now generate the start tag
     (let ((tag   (gnc:html-markup-style-info-tag childinfo))
           (attr  (gnc:html-markup-style-info-attributes childinfo))
@@ -343,21 +338,14 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (gnc:html-document-render-data doc data)
-  (let ((style-info #f)
-        (data-type #f))
-    (cond
-     ((number? data)
-      (set! data-type "<number>"))
-     ((string? data)
-      (set! data-type "<string>"))
-     ((boolean? data)
-      (set! data-type "<boolean>"))
-     ((record? data)
-      (set! data-type (record-type-name (record-type-descriptor data))))
-     (#t
-      (set! data-type "<generic>")))
-
-    (set! style-info (gnc:html-document-fetch-data-style doc data-type))
+  (let* ((data-type (cond
+                     ((number? data) "<number>")
+                     ((string? data) "<string>")
+                     ((boolean? data) "<boolean>")
+                     ((record? data) (record-type-name
+                                      (record-type-descriptor data)))
+                     (else "<generic>")))
+         (style-info (gnc:html-document-fetch-data-style doc data-type)))
 
     ((gnc:html-data-style-info-renderer style-info)
      data (gnc:html-data-style-info-data style-info))))
@@ -380,51 +368,47 @@
   (record-constructor <html-object>))
 
 (define (gnc:make-html-object obj)
-  (let ((o #f))
-    (if (not (record? obj))
-        ;; for literals (strings/numbers)
-        (set! o
-              (gnc:make-html-object-internal
-               (lambda (obj doc)
-                 (gnc:html-document-render-data doc obj))
-               ;; if the object is #f, make it a placeholder
-               (if obj obj " ")))
-        (cond 
-         ((gnc:html-text? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-text-render obj)))
-         ((gnc:html-table? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-table-render obj)))
-         ((gnc:html-anytag? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-anytag-render obj)))
-         ((gnc:html-table-cell? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-table-cell-render obj)))
-         ((gnc:html-barchart? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-barchart-render obj)))
-         ((gnc:html-piechart? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-piechart-render obj)))
-         ((gnc:html-scatter? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-scatter-render obj)))
-         ((gnc:html-linechart? obj)
-          (set! o (gnc:make-html-object-internal
-                   gnc:html-linechart-render obj)))
-         ((gnc:html-object? obj)
-          (set! o obj))
-
-         ;; other record types that aren't HTML objects
-         (#t
-          (set! o
-                (gnc:make-html-object-internal
-                 (lambda (obj doc)
-                   (gnc:html-document-render-data doc obj))
-                 obj)))))
-    o))
+  (cond
+   ((not (record? obj))
+    ;; for literals (strings/numbers)
+    ;; if the object is #f, make it a placeholder
+    (gnc:make-html-object-internal
+     (lambda (obj doc)
+       (gnc:html-document-render-data doc obj))
+     (or obj " ")))
+
+   ((gnc:html-text? obj)
+    (gnc:make-html-object-internal gnc:html-text-render obj))
+
+   ((gnc:html-table? obj)
+    (gnc:make-html-object-internal gnc:html-table-render obj))
+
+   ((gnc:html-anytag? obj)
+    (gnc:make-html-object-internal gnc:html-anytag-render obj))
+
+   ((gnc:html-table-cell? obj)
+    (gnc:make-html-object-internal gnc:html-table-cell-render obj))
+
+   ((gnc:html-barchart? obj)
+    (gnc:make-html-object-internal gnc:html-barchart-render obj))
+
+   ((gnc:html-piechart? obj)
+    (gnc:make-html-object-internal gnc:html-piechart-render obj))
+
+   ((gnc:html-scatter? obj)
+    (gnc:make-html-object-internal gnc:html-scatter-render obj))
+
+   ((gnc:html-linechart? obj)
+    (gnc:make-html-object-internal gnc:html-linechart-render obj))
+
+   ((gnc:html-object? obj)
+    obj)
+
+   ;; other record types that aren't HTML
+   (else
+    (gnc:make-html-object-internal
+     (lambda (obj doc)
+       (gnc:html-document-render-data doc obj)) obj))))
 
 (define gnc:html-object-renderer
   (record-accessor <html-object> 'renderer))

commit fe6cc534a09e6ad84e0296a712e556a71784e21e
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Feb 14 21:02:43 2019 +0800

    [engine-utilities] deprecate account utility functions
    
    These functions are obsolete with SRFI-1

diff --git a/libgnucash/engine/engine-utilities.scm b/libgnucash/engine/engine-utilities.scm
index cc692ff1b..6341a9974 100644
--- a/libgnucash/engine/engine-utilities.scm
+++ b/libgnucash/engine/engine-utilities.scm
@@ -38,11 +38,13 @@
 ;; account related functions
 ;; is account in list of accounts?
 (define (account-same? a1 a2)
+  (issue-deprecation-warning "account-same? is deprecated. use equal? instead.")
   (or (eq? a1 a2)
       (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2))))
 
 (define account-in-list?
   (lambda (account accounts)
+    (issue-deprecation-warning "account-in-list? is deprecated. use member instead.")
     (cond
      ((null? accounts) #f)
      ((account-same? (car accounts) account) #t)
@@ -55,6 +57,7 @@
     (find (lambda (pair) (account-same? str (car pair))) alist))
   (define (my-hash acc size)
     (remainder (string-hash (gncAccountGetGUID acc)) size))
+  (issue-deprecation-warning "account-in-list-pred is deprecated.")
   (let ((hash-table (make-hash-table)))
     (for-each (lambda (acc) (hashx-set! my-hash my-assoc hash-table acc #t))
 	      accounts)
@@ -63,6 +66,7 @@
 
 (define account-in-alist
   (lambda (account alist)
+    (issue-deprecation-warning "account-in-alist is deprecated. use assoc instead.")
     (cond
      ((null? alist) #f)
      ((account-same? (caar alist) account) (car alist))
@@ -81,15 +85,21 @@
 	      accounts)))
 
 (define (account-assoc acc alist)
+  (issue-deprecation-warning "account-assoc is deprecated. use assoc instead.")
   (find (lambda (pair) (account-same? acc (car pair))) alist))
 
 (define (account-hash acc size)
+  (issue-deprecation-warning "account-hash is deprecated. internal function.")
   (remainder (string-hash (gncAccountGetGUID acc)) size))
 
 (define (account-hashtable-ref table account)
+  (issue-deprecation-warning "account-hashtable-ref is deprecated. \
+use assoc-ref instead..")
   (hashx-ref account-hash account-assoc table account))
 
 (define (account-hashtable-set! table account value)
+  (issue-deprecation-warning "account-hashtable-set! is deprecated. \
+use assoc-set! instead.")
   (hashx-set! account-hash account-assoc table account value))
 
 ;; Splits
diff --git a/libgnucash/engine/engine.scm b/libgnucash/engine/engine.scm
index 0c9ace487..d6cb780cf 100644
--- a/libgnucash/engine/engine.scm
+++ b/libgnucash/engine/engine.scm
@@ -63,15 +63,14 @@
 (export gnc:account-map-descendants)
 (export gnc:account-map-children)
 
-(export account-same?)
-(export account-in-list?)
-(export account-in-list-pred)
-(export account-in-alist)
+(export account-same?)                  ;deprecated
+(export account-in-list?)               ;deprecated
+(export account-in-list-pred)           ;deprecated
+(export account-in-alist)               ;deprecated
 (export account-full-name<?)
-(export account-list-predicate)
 (export accounts-get-children-depth)
-(export account-hashtable-ref)
-(export account-hashtable-set!)
+(export account-hashtable-ref)          ;deprecated
+(export account-hashtable-set!)         ;deprecated
 
 (export split-same?)                    ;deprecated
 (export split-in-list?)                 ;deprecated
diff --git a/libgnucash/engine/test/test-account.scm b/libgnucash/engine/test/test-account.scm
index e76aaffad..e2ad2c454 100644
--- a/libgnucash/engine/test/test-account.scm
+++ b/libgnucash/engine/test/test-account.scm
@@ -6,6 +6,8 @@
 
 (use-modules (gnucash engine test test-extras))
 
+;; this test suite tests deprecated functions.
+
 (define (run-test)
   (test test-account-same?)
   (test test-account-in-list?)

commit 972562421eeb5c62ed407630f5cd574a796de747
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Feb 14 20:59:27 2019 +0800

    [engine-utilities] deprecate split utility functions
    
    These functions are obsolete with srfi-1

diff --git a/libgnucash/engine/engine-utilities.scm b/libgnucash/engine/engine-utilities.scm
index 83b363e86..cc692ff1b 100644
--- a/libgnucash/engine/engine-utilities.scm
+++ b/libgnucash/engine/engine-utilities.scm
@@ -93,33 +93,34 @@
   (hashx-set! account-hash account-assoc table account value))
 
 ;; Splits
-(export split-same?)
-(export split-in-list?)
-
+(export split-same?)                    ;deprecated
+(export split-in-list?)                 ;deprecated
 (define (split-same? s1 s2)
+  (issue-deprecation-warning "split-same? is deprecated. use equal? instead.")
   (or (eq? s1 s2)
       (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2))))
-
 (define split-in-list? 
   (lambda (split splits)
+    (issue-deprecation-warning "split-in-list? is deprecated. use member instead.")
     (cond 
      ((null? splits) #f)
      ((split-same? (car splits) split) #t)
      (else (split-in-list? split (cdr splits))))))
-
-;; Split hashtable. Because we do gncSplitGetGUID so often, it
-;; turns out to be a bit quicker to store a (hash, split) pair
-;; instead of just the split.
 (define (split-assoc split alist)
+  (issue-deprecation-warning "split-assoc is deprecated. use assoc instead")
   (find (lambda (pair) (split-same? (cdr split) (cdr (car pair)))) alist))
 (define (split-hash split size)
+  (issue-deprecation-warning "split-hash is deprecated. \
+internal function -- no srfi-1 equivalent")
   (remainder (car split) size))
-
 (define (split-hashtable-ref table split)
+  (issue-deprecation-warning "split-hashtable-ref is deprecated. \
+use assoc-ref instead.")
   (hashx-ref split-hash split-assoc table
 	     (cons (string-hash (gncSplitGetGUID split)) split)))
-
 (define (split-hashtable-set! table split value)
+  (issue-deprecation-warning "split-hashtable-set! is deprecated. \
+use assoc-set! instead")
   (hashx-set! split-hash split-assoc table
 	      (cons (string-hash (gncSplitGetGUID split)) split) value))
 
diff --git a/libgnucash/engine/engine.scm b/libgnucash/engine/engine.scm
index b3023a3f1..0c9ace487 100644
--- a/libgnucash/engine/engine.scm
+++ b/libgnucash/engine/engine.scm
@@ -73,13 +73,10 @@
 (export account-hashtable-ref)
 (export account-hashtable-set!)
 
-(export split-same?)
-(export split-in-list?)
-
-(export split-same?)
-(export split-in-list?)
-(export split-hashtable-ref)
-(export split-hashtable-set!)
+(export split-same?)                    ;deprecated
+(export split-in-list?)                 ;deprecated
+(export split-hashtable-ref)            ;deprecated
+(export split-hashtable-set!)           ;deprecated
 
 (export gnc:split-structure)
 (export gnc:make-split-scm)
diff --git a/libgnucash/engine/test/test-split.scm b/libgnucash/engine/test/test-split.scm
index 96713c44d..e5f53a6ef 100644
--- a/libgnucash/engine/test/test-split.scm
+++ b/libgnucash/engine/test/test-split.scm
@@ -11,6 +11,7 @@
   (test test-split-in-list?))
 
 (define (test-split-in-list?)
+  ;; this test suite tests deprecated functions.
   (let* ((env (create-test-env))
 	 (today (current-time))
 	 (account-alist (env-create-test-accounts env))



Summary of changes:
 gnucash/report/report-system/html-document.scm     | 178 +++++++++------------
 .../report/report-system/test/test-report-html.scm |   3 +-
 libgnucash/engine/engine-utilities.scm             |  31 ++--
 libgnucash/engine/engine.scm                       |  24 ++-
 libgnucash/engine/test/test-account.scm            |   2 +
 libgnucash/engine/test/test-split.scm              |   1 +
 6 files changed, 115 insertions(+), 124 deletions(-)



More information about the gnucash-changes mailing list