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