gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Mon Dec 2 09:29:33 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/7833c598 (commit)
via https://github.com/Gnucash/gnucash/commit/7ad4c4af (commit)
via https://github.com/Gnucash/gnucash/commit/8bf54ebf (commit)
via https://github.com/Gnucash/gnucash/commit/ab20071d (commit)
via https://github.com/Gnucash/gnucash/commit/2333b6db (commit)
via https://github.com/Gnucash/gnucash/commit/3ee434ed (commit)
via https://github.com/Gnucash/gnucash/commit/4aa17ef6 (commit)
via https://github.com/Gnucash/gnucash/commit/a52d60f4 (commit)
from https://github.com/Gnucash/gnucash/commit/df1f033f (commit)
commit 7833c59896b2d2705084732407277778ebb8ed85
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 16:38:25 2019 +0800
Bug 724219 - Customer Summary includes Closing Entries when reporting across the end of year
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 1f05883df..f2ed8f4de 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -203,6 +203,7 @@
;; guid QOF-QUERY-OR)
(xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
(xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND)
+ (xaccQueryAddClosingTransMatch q #f QOF-QUERY-AND)
(qof-query-set-book q (gnc-get-current-book))
(let ((result (qof-query-run q)))
(qof-query-destroy q)
commit 7ad4c4afbdd50dec5751f93d5e25bea39c806e25
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 18:19:28 2019 +0800
[html-acct-table] compact gnc:html-acct-table-get-cell
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index e8cf33e12..71f668b82 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -850,12 +850,9 @@
(define (gnc:html-acct-table-get-cell acct-table row col)
;; we'll only ever store one object in an html-table-cell
;; returns the first object stored in that cell
- (let* ((cell (gnc:html-table-get-cell
- (gnc:_html-acct-table-matrix_ acct-table)
- row (+ col 1))))
- (and cell (car (gnc:html-table-cell-data cell)))
- )
- )
+ (and-let* ((cell (gnc:html-table-get-cell
+ (gnc:_html-acct-table-matrix_ acct-table) row (1+ col))))
+ (car (gnc:html-table-cell-data cell))))
(define (gnc:html-acct-table-set-cell! acct-table row col obj)
(gnc:html-table-set-cell!
commit 8bf54ebfc1c2da11bb1c16c41ed12d1e5ae2b2c8
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 08:50:56 2019 +0800
[html-acct-table] compact traverse-accounts!
* convert for-each to named-let
* allows reduction of set! calls
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index 721330c87..e8cf33e12 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -616,7 +616,6 @@
)
;; the following function was adapted from html-utilities.scm
- ;;
;; helper to calculate the balances for all required accounts
(define (calculate-balances accts start-date end-date get-balance-fn)
@@ -673,19 +672,18 @@
(define (traverse-accounts! accts acct-depth logi-depth new-balances)
(define (use-acct? acct)
- ;; BUG? when depth-limit is not integer but boolean?
- (and (or (eq? limit-behavior 'flatten)
+ (and (or (eq? limit-behavior 'flatten)
(< logi-depth depth-limit))
- (member acct accounts)))
-
- ;; helper function to return a cached balance from a list of
+ (member acct accounts)))
+
+ ;; helper function to return a cached balance from a list of
;; ( acct . balance ) cells
(define (get-balance acct-balances acct)
- (let ((this-collector (gnc:make-commodity-collector))
+ (let ((this-collector (gnc:make-commodity-collector))
(acct-coll (hash-ref acct-balances (gncAccountGetGUID acct)
(gnc:make-commodity-collector))))
- (this-collector 'merge acct-coll #f)
- this-collector))
+ (this-collector 'merge acct-coll #f)
+ this-collector))
;; helper function that returns a cached balance from a list of
;; ( acct . balance) cells for the given account *and* its
@@ -696,217 +694,151 @@
(lambda (acct)
(this-collector 'merge (get-balance acct-balances acct) #f))
(gnc:accounts-and-all-descendants (list account)))
- this-collector))
-
- (let ((disp-depth (if (integer? depth-limit)
- (min (- depth-limit 1) logi-depth)
- logi-depth))
- (row-added? #f))
-
- (for-each
- (lambda (acct)
- (let* ((subaccts (gnc-account-get-children-sorted acct))
- ;; assign output parameters
- (account acct)
- (account-name (xaccAccountGetName acct))
- (account-code (xaccAccountGetCode acct))
- (account-path (gnc-account-get-full-name acct))
- (account-anchor (gnc:html-account-anchor acct))
- (account-parent (gnc-account-get-parent acct))
- (account-children subaccts)
- (account-depth acct-depth)
- (logical-depth logi-depth)
- (account-commodity (xaccAccountGetCommodity acct))
- (account-type (xaccAccountGetType acct))
- ;; N.B.: xaccAccountGetTypeStr really should be
- ;; called gnc:account-type-get-string
- (account-type-string (xaccAccountGetTypeStr
- (xaccAccountGetType acct)))
- (account-guid (gncAccountGetGUID acct))
- (account-description (xaccAccountGetDescription acct))
- (account-notes (xaccAccountGetNotes acct))
- ;; These next two are commodity-collectors.
- (account-bal (get-balance
- new-balances acct))
- (recursive-bal (get-balance-sub
- new-balances acct))
- ;; These next two are of type <gnc:monetary>, right?
- (report-comm-account-bal
- (gnc:sum-collector-commodity
- account-bal report-commodity exchange-fn))
- (report-comm-recursive-bal
- (gnc:sum-collector-commodity
- recursive-bal report-commodity exchange-fn))
- (grp-env
- (append env
- (list
- (list 'initial-indent indent)
- (list 'account account)
- (list 'account-name account-name)
- (list 'account-code account-code)
- (list 'account-type account-type)
- (list 'account-type-string account-type-string)
- (list 'account-guid account-guid)
- (list 'account-description account-description)
- (list 'account-notes account-notes)
- (list 'account-path account-path)
- (list 'account-parent account-parent)
- (list 'account-children account-children)
- (list 'account-depth account-depth)
- (list 'logical-depth logical-depth)
- (list 'account-commodity account-commodity)
- (list 'account-anchor account-anchor)
- (list 'account-bal account-bal)
- (list 'recursive-bal recursive-bal)
- (list 'report-comm-account-bal
- report-comm-account-bal)
- (list 'report-comm-recursive-bal
- report-comm-recursive-bal)
- (list 'report-commodity report-commodity)
- (list 'exchange-fn exchange-fn)
- )))
- (row-env #f)
- (label (case label-mode
- ((anchor) account-anchor)
- ((name) (gnc:make-html-text account-name))))
- (row #f)
- (children-displayed? #f)
- )
+ this-collector))
+
+ (let lp ((accounts (if less-p (sort accts less-p) accts))
+ (row-added? #f)
+ (disp-depth (if (integer? depth-limit)
+ (min (1- depth-limit) logi-depth)
+ logi-depth)))
+
+ (cond
+
+ ((null? accounts) row-added?)
+
+ (else
+ (let* ((acct (car accounts))
+ (subaccts (gnc-account-get-children-sorted acct))
+
+ ;; These next two are commodity-collectors.
+ (account-bal (get-balance new-balances acct))
+ (recursive-bal (get-balance-sub new-balances acct))
+
+ ;; These next two are of type <gnc:monetary>
+ (report-comm-account-bal
+ (gnc:sum-collector-commodity
+ account-bal report-commodity exchange-fn))
+ (report-comm-recursive-bal
+ (gnc:sum-collector-commodity
+ recursive-bal report-commodity exchange-fn))
+
+ (grp-env
+ (cons*
+ (list 'initial-indent indent)
+ (list 'account acct)
+ (list 'account-name (xaccAccountGetName acct))
+ (list 'account-code (xaccAccountGetCode acct))
+ (list 'account-type (xaccAccountGetType acct))
+ (list 'account-type-string (xaccAccountGetTypeStr
+ (xaccAccountGetType acct)))
+ (list 'account-guid (gncAccountGetGUID acct))
+ (list 'account-description (xaccAccountGetDescription acct))
+ (list 'account-notes (xaccAccountGetNotes acct))
+ (list 'account-path (gnc-account-get-full-name acct))
+ (list 'account-parent (gnc-account-get-parent acct))
+ (list 'account-children subaccts)
+ (list 'account-depth acct-depth)
+ (list 'logical-depth logi-depth)
+ (list 'account-commodity (xaccAccountGetCommodity acct))
+ (list 'account-anchor (gnc:html-account-anchor acct))
+ (list 'account-bal account-bal)
+ (list 'recursive-bal recursive-bal)
+ (list 'report-comm-account-bal report-comm-account-bal)
+ (list 'report-comm-recursive-bal report-comm-recursive-bal)
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ env))
+ (label (case label-mode
+ ((anchor) (gnc:html-account-anchor acct))
+ ((name) (gnc:make-html-text (xaccAccountGetName acct)))))
+ (row #f)
+ (children-displayed? #f))
+
+ (set! acct-depth-reached (max acct-depth-reached acct-depth))
+ (set! logi-depth-reached (max logi-depth-reached logi-depth))
+ (set! disp-depth-reached (max disp-depth-reached disp-depth))
- (set! acct-depth-reached (max acct-depth-reached acct-depth))
- (set! logi-depth-reached (max logi-depth-reached logi-depth))
- (set! disp-depth-reached (max disp-depth-reached disp-depth))
-
- (or (not (use-acct? acct))
- ;; ok, so we'll consider parent accounts with zero
- ;; recursive-bal to be zero balance leaf accounts
- (and (gnc-commodity-collector-allzero? recursive-bal)
- (or (not report-budget)
- (gnc-numeric-zero-p
- (gnc:budget-account-get-rolledup-net
- report-budget account #f #f)))
- (equal? zero-mode 'omit-leaf-acct))
- (begin
- (set! row-env
- (append grp-env
- (list
- (list 'account-label label)
- (list 'row-type 'account-row)
- (list 'display-depth disp-depth)
- (list 'indented-depth
- (+ disp-depth indent))
- )
- ))
- (set! row (add-row row-env))
- )
- )
- ;; Recurse:
- ;; Dive into an account even if it isn't selected!
- ;; why? because some subaccts may be selected.
- (set! children-displayed?
- (traverse-accounts! subaccts
- (+ acct-depth 1)
- (if (use-acct? acct)
- (+ logi-depth 1)
- logi-depth)
- new-balances))
-
- ;; record whether any children were displayed
- (if row (append-to-row row (list (list 'children-displayed? children-displayed?))))
-
- ;; after the return from recursion: subtotals
- (or (not (use-acct? acct))
- (not subtotal-mode)
- ;; ditto that remark concerning zero recursive-bal...
- (and (gnc-commodity-collector-allzero? recursive-bal)
- (equal? zero-mode 'omit-leaf-acct))
- ;; ignore use-acct for subtotals...?
- ;; (not (use-acct? acct))
- (not children-displayed?)
- (let* ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
- (apply gnc:html-text-append! lbl-txt
- (gnc:html-text-body label))
- (if (equal? subtotal-mode 'canonically-tabbed)
- (set! disp-depth (+ disp-depth 1))
- (set! disp-depth-reached
- (max disp-depth-reached disp-depth))
- )
- (set! row-env
- (append grp-env
- (list
- (list 'account-label lbl-txt)
- (list 'row-type 'subtotal-row)
- (list 'display-depth disp-depth)
- (list 'indented-depth
- (+ disp-depth indent))
- )
- ))
- (add-row row-env)
- )
- )
- (if (or row-added? children-displayed? row) (set! row-added? #t))
- )) ;; end of (lambda (acct) ...)
- ;; lambda is applied to each item in the (sorted) account list
- (if less-p
- (sort accts less-p)
- accts)
- ) ;; end of for-each
- row-added?
- )
- ) ;; end of definition of traverse-accounts!
+ (unless (or (not (use-acct? acct))
+ ;; ok, so we'll consider parent accounts with zero
+ ;; recursive-bal to be zero balance leaf accounts
+ (and (gnc-commodity-collector-allzero? recursive-bal)
+ (eq? zero-mode 'omit-leaf-acct)
+ (or (not report-budget)
+ (zero? (gnc:budget-account-get-rolledup-net
+ report-budget acct #f #f)))))
+ (set! row
+ (add-row
+ (cons* (list 'account-label label)
+ (list 'row-type 'account-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth (+ disp-depth indent))
+ grp-env))))
+
+ ;; Recurse:
+ ;; Dive into an account even if it isn't selected!
+ ;; why? because some subaccts may be selected.
+ (set! children-displayed?
+ (traverse-accounts! subaccts
+ (1+ acct-depth)
+ (if (use-acct? acct)
+ (1+ logi-depth)
+ logi-depth)
+ new-balances))
+
+ ;; record whether any children were displayed
+ (when row
+ (append-to-row
+ row (list (list 'children-displayed? children-displayed?))))
+
+ ;; after the return from recursion: subtotals
+ (unless (or (not (use-acct? acct))
+ (not subtotal-mode)
+ (not children-displayed?)
+ (and (gnc-commodity-collector-allzero? recursive-bal)
+ (eq? zero-mode 'omit-leaf-acct)))
+ (let ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
+ (apply gnc:html-text-append! lbl-txt (gnc:html-text-body label))
+ (if (eq? subtotal-mode 'canonically-tabbed)
+ (set! disp-depth (+ disp-depth 1))
+ (set! disp-depth-reached (max disp-depth-reached disp-depth)))
+ (add-row
+ (cons* (list 'account-label lbl-txt)
+ (list 'row-type 'subtotal-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth (+ disp-depth indent))
+ grp-env))))
+
+ (lp (cdr accounts)
+ (or row-added? children-displayed? row)
+ disp-depth))))))
;; do it
- (traverse-accounts! toplvl-accts 0 0
- (calculate-balances accounts start-date end-date get-balance-fn))
-
+ (traverse-accounts!
+ toplvl-accts 0 0
+ (calculate-balances accounts start-date end-date get-balance-fn))
+
;; now set the account-colspan entries
- ;; he he... (let ((x 0)) (while (< x 5) (display x) (set! x (+ x 1))))
- ;; now I know how to loop in scheme... yay!
- (let ((row 0)
- (rows (gnc:html-acct-table-num-rows acct-table)))
- (while (< row rows)
- (let* ((orig-env
- (gnc:html-acct-table-get-row-env acct-table row))
- (display-depth (get-val orig-env 'display-depth))
- (depth-limit (get-val orig-env 'display-tree-depth))
- (indent (get-val orig-env 'initial-indent))
- (indented-depth (get-val orig-env 'indented-depth))
- (subtotal-mode
- (get-val orig-env 'parent-account-subtotal-mode))
- (label-cols (+ disp-depth-reached 1))
- (logical-cols (if depth-limit
- (min
- (+ logi-depth-reached 1)
- ;; BUG? when depth-limit is not integer?
- depth-limit)
- (+ logi-depth-reached 1)))
- (colspan (- label-cols display-depth))
- ;; these parameters *should* always, by now, be set...
- (new-env
- (append
- orig-env
- (list
- (list 'account-colspan colspan)
- (list 'label-cols label-cols)
- (list 'logical-cols logical-cols)
- (list 'account-cols
- (+ indent
- (max label-cols
- (if depth-limit depth-limit 0)
- )
- )
- )
- )
- ))
- )
- (gnc:html-acct-table-set-row-env! acct-table row new-env)
- (set! row (+ row 1))))
- )
-
- ;; done
-
- )
- )
+ (let lp ((row 0)
+ (rows (gnc:html-acct-table-num-rows acct-table)))
+ (when (< row rows)
+ (let* ((orig-env (gnc:html-acct-table-get-row-env acct-table row))
+ (display-depth (get-val orig-env 'display-depth))
+ (depth-limit (get-val orig-env 'display-tree-depth))
+ (indent (get-val orig-env 'initial-indent))
+ (indented-depth (get-val orig-env 'indented-depth))
+ (subtotal-mode (get-val orig-env 'parent-account-subtotal-mode))
+ (label-cols (+ disp-depth-reached 1))
+ ;; these parameters *should* always, by now, be set...
+ (new-env
+ (cons*
+ (list 'account-colspan (- label-cols display-depth))
+ (list 'label-cols label-cols)
+ (list 'account-cols (+ indent (max label-cols (or depth-limit 0))))
+ (list 'logical-cols (min (+ logi-depth-reached)
+ (or depth-limit +inf.0)))
+ orig-env)))
+ (gnc:html-acct-table-set-row-env! acct-table row new-env)
+ (lp (1+ row) rows))))))
(define (gnc:html-acct-table-num-rows acct-table)
(gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))
commit ab20071d828c6541cebb233954cd748b32b1f2ba
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 08:26:01 2019 +0800
[report-utilities] strify hash-table to Hash(kvp-list)
Hash tables are strified to "Hash()" "Hash(key=value,...)"
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 75b5afb06..459609e9b 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1259,6 +1259,18 @@ flawed. see report-utilities.scm. please update reports.")
(gnc-lot-get-notes lot)
(gnc-lot-get-balance lot)
(gnc-lot-count-splits lot)))
+ (define (record->str rec)
+ (let ((rtd (record-type-descriptor rec)))
+ (define (fld->str fld)
+ (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) rec))))
+ (format #f "Rec:~a{~a}"
+ (record-type-name rtd)
+ (string-join (map fld->str (record-type-fields rtd)) ", "))))
+ (define (hash-table->str hash)
+ (string-append
+ "Hash(" (string-join
+ (hash-map->list (lambda (k v) (format #f "~a=~a" k v)) hash) ",")
+ ")"))
(define (try proc)
;; Try proc with d as a parameter, catching exceptions to return
;; #f to the (or) evaluator below.
@@ -1294,13 +1306,8 @@ flawed. see report-utilities.scm. please update reports.")
(try owner->str)
(try invoice->str)
(try lot->str)
- (and (record? d)
- (let ((rtd (record-type-descriptor d)))
- (define (fld->str fld)
- (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d))))
- (format #f "Rec:~a{~a}"
- (record-type-name rtd)
- (string-join (map fld->str (record-type-fields rtd)) ", "))))
+ (try hash-table->str)
+ (try record->str)
(object->string d)))
(define (pair->num pair)
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index b0f12da76..13921d47c 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -152,6 +152,16 @@
(test-equal "gnc:strify <val-coll 10>"
"coll<10>"
(gnc:strify coll)))
+
+ (let ((ht (make-hash-table)))
+ (test-equal "gnc:strify Hash()"
+ "Hash()"
+ (gnc:strify ht))
+ (hash-set! ht 'one "uno")
+ (test-equal "gnc:strify Hash(one=uno)"
+ "Hash(one=uno)"
+ (gnc:strify ht)))
+
(test-end "debugging tools"))
(define (test-commodity-collector)
commit 2333b6db271ad50bf5a3c5825990647b73077913
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 23:10:22 2019 +0800
[reports] avoid "<br/>" literal: use gnc:multiline-to-html-text
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index e0ab202cd..1f05883df 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -179,17 +179,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (string-expand string character replace-string)
- (with-output-to-string
- (lambda ()
- (string-for-each
- (lambda (c)
- (display
- (if (char=? c character)
- replace-string
- c)))
- string))))
-
(define (query owner account-list start-date end-date)
(let* ((q (qof-query-create-for-splits))
(guid (and owner
@@ -232,8 +221,7 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
(if name (gnc:html-table-append-row! table (list name)))
- (if addy (gnc:html-table-append-row!
- table (list (string-expand addy #\newline "<br/>"))))
+ (if addy (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy)))
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
(let ((table-outer (gnc:make-html-table)))
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 0beef5c12..84bf7eedb 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -178,15 +178,7 @@
keylist))
(define (multiline-to-html-text str)
- ;; simple function - splits string containing #\newline into
- ;; substrings, and convert to a gnc:make-html-text construct which
- ;; adds gnc:html-markup-br after each substring.
- (let loop ((list-of-substrings (string-split str #\newline))
- (result '()))
- (if (null? list-of-substrings)
- (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
- (loop (cdr list-of-substrings)
- (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
+ (gnc:multiline-to-html-text str))
(define (options-generator variant)
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index 60954b02d..c8fc66cfd 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -416,24 +416,6 @@
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE
(_ "Expense Report") #t))
-(define (string-expand string character replace-string)
- (define (car-line chars)
- (take-while (lambda (c) (not (eqv? c character))) chars))
- (define (cdr-line chars)
- (let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
- (if (null? rest)
- '()
- (cdr rest))))
- (define (line-helper chars)
- (if (null? chars)
- ""
- (let ((first (car-line chars))
- (rest (cdr-line chars)))
- (string-append (list->string first)
- (if (null? rest) "" replace-string)
- (line-helper rest)))))
- (line-helper (string->list string)))
-
(define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID owner)))
@@ -464,13 +446,15 @@
'attribute (list "border" 0)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
+
(gnc:html-table-append-row!
table
- (list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
+ (list (gnc:multiline-to-html-text
+ (gnc:owner-get-name-and-address-dep owner))))
+
(gnc:html-table-append-row!
- table
- (list "<br/>"))
+ table (gnc:make-html-text (gnc:html-markup-br)))
+
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
@@ -507,10 +491,10 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row! table (list (if name name "")))
- (gnc:html-table-append-row! table (list (string-expand
- (if addy addy "")
- #\newline "<br/>")))
+ (gnc:html-table-append-row! table (list (or name "")))
+
+ (gnc:html-table-append-row! table (list (gnc:multiline-to-html-text (or addy ""))))
+
(gnc:html-table-append-row!
table (list (gnc-print-time64 (current-time) date-format)))
table))
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 6c956d5df..dbec87511 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -627,24 +627,6 @@
(define (employee-options-generator)
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t))
-(define (string-expand string character replace-string)
- (define (car-line chars)
- (take-while (lambda (c) (not (eqv? c character))) chars))
- (define (cdr-line chars)
- (let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
- (if (null? rest)
- '()
- (cdr rest))))
- (define (line-helper chars)
- (if (null? chars)
- ""
- (let ((first (car-line chars))
- (rest (cdr-line chars)))
- (string-append (list->string first)
- (if (null? rest) "" replace-string)
- (line-helper rest)))))
- (line-helper (string->list string)))
-
(define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
@@ -675,16 +657,17 @@
'attribute (list "border" 0)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
+
(gnc:html-table-append-row!
- table
- (list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
+ table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
+
(gnc:html-table-append-row!
- table
- (list "<br/>"))
+ table (gnc:make-html-text (gnc:html-markup-br)))
+
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
+
table))
(define (make-date-row! table label date)
@@ -718,12 +701,14 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row! table (list (if name name "")))
- (gnc:html-table-append-row! table (list (string-expand
- (if addy addy "")
- #\newline "<br/>")))
+ (gnc:html-table-append-row! table (list (or name "")))
+
+ (gnc:html-table-append-row!
+ table (list (gnc:multiline-to-html-text (or addy ""))))
+
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
+
table))
(define (make-break! document)
commit 3ee434edf6658fde0d79bceb0516e7789b6cd230
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:17:37 2019 +0800
[new-aging] use gnc:html-markup-ol
diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm
index cd5362a99..5f0f8ba5a 100644
--- a/gnucash/report/business-reports/new-aging.scm
+++ b/gnucash/report/business-reports/new-aging.scm
@@ -225,10 +225,6 @@ exist but have no suitable transactions."))
((if (eq? sort-order 'increasing) string<? string>?)
(gncOwnerGetName a) (gncOwnerGetName b)))
- (define (html-markup-ol lst)
- (apply gnc:html-markup "ol"
- (map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
-
;; set default title
(gnc:html-document-set-title! document report-title)
@@ -340,7 +336,7 @@ exist but have no suitable transactions."))
document
(gnc:make-html-text
(_ "Please note some transactions were not processed")
- (html-markup-ol
+ (gnc:html-markup-ol
(map
(lambda (invalid-split)
(gnc:html-markup-anchor
commit 4aa17ef65bb0bd1cec3be632fc8af54769169431
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:17:19 2019 +0800
[html-text][API] gnc:html-markup-ol, gnc:multiline-to-html-text
* (gnc:html-markup-ol lst)
creates an ordered list
* gnc:multiline-to-html-text: creates html-text with <br/> elements
"line1\nline2\nline3" ->
(gnc:make-html-text "line1" (gnc:html-markup-br)
"line2" (gnc:html-markup-br)
"line3")
diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm
index fd1f29ade..d34e2154b 100644
--- a/gnucash/report/report-system/html-text.scm
+++ b/gnucash/report/report-system/html-text.scm
@@ -182,6 +182,9 @@
(gnc:html-markup "li" obj))
items)))
+(define (gnc:html-markup-ol lst)
+ (apply gnc:html-markup "ol"
+ (map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
(define (gnc:html-markup-anchor href . rest)
(apply gnc:html-markup/attr
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index a351038b0..cd0e32526 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -666,6 +666,7 @@
(export gnc:html-markup-h3)
(export gnc:html-markup-br)
(export gnc:html-markup-hr)
+(export gnc:html-markup-ol)
(export gnc:html-markup-ul)
(export gnc:html-markup-anchor)
(export gnc:html-markup-img)
@@ -744,6 +745,7 @@
(export gnc:get-assoc-account-balances)
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
+(export gnc:multiline-to-html-text)
(export make-file-url)
(export gnc:strify)
(export gnc:pk)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index f2cfaad44..75b5afb06 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1109,6 +1109,16 @@ flawed. see report-utilities.scm. please update reports.")
account-balances)
total))
+(define (gnc:multiline-to-html-text str)
+ ;; simple function - splits string containing #\newline into
+ ;; substrings, and convert to a gnc:make-html-text construct which
+ ;; adds gnc:html-markup-br after each substring.
+ (let loop ((list-of-substrings (string-split str #\newline))
+ (result '()))
+ (if (null? list-of-substrings)
+ (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
+ (loop (cdr list-of-substrings)
+ (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
;; ***************************************************************************
;; Business Functions
commit a52d60f48e738ee4c91bfa03887dea1014f104fa
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:30:45 2019 +0800
[business-reports] compact gnc:owner-report-text
diff --git a/gnucash/report/business-reports/business-reports.scm b/gnucash/report/business-reports/business-reports.scm
index 7c50821a9..a9bb791ec 100644
--- a/gnucash/report/business-reports/business-reports.scm
+++ b/gnucash/report/business-reports/business-reports.scm
@@ -71,29 +71,17 @@
(define (gnc:owner-report-text owner acc)
(let* ((end-owner (gncOwnerGetEndOwner owner))
- (type (gncOwnerGetType end-owner))
- (ref #f))
-
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (set! ref "owner=c:"))
-
- ((eqv? type GNC-OWNER-VENDOR)
- (set! ref "owner=v:"))
-
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (set! ref "owner=e:"))
-
- (else (set! ref "unknown-type=")))
-
- (if ref
- (begin
- (set! ref (string-append ref (gncOwnerReturnGUID end-owner)))
- (if (not (null? acc))
- (set! ref (string-append ref "&acct="
- (gncAccountGetGUID acc))))
- (gnc-build-url URL-TYPE-OWNERREPORT ref ""))
- ref)))
+ (type (gncOwnerGetType end-owner)))
+ (gnc-build-url
+ URL-TYPE-OWNERREPORT
+ (string-append
+ (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:")
+ ((eqv? type GNC-OWNER-VENDOR) "owner=v:")
+ ((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:")
+ (else "unknown-type="))
+ (gncOwnerReturnGUID end-owner)
+ (if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc))))
+ "")))
;; Creates a new report instance for the given invoice. The given
;; report-template-id must refer to an existing report template, which
Summary of changes:
.../report/business-reports/business-reports.scm | 34 +-
.../report/business-reports/customer-summary.scm | 15 +-
gnucash/report/business-reports/invoice.scm | 10 +-
gnucash/report/business-reports/job-report.scm | 36 +-
gnucash/report/business-reports/new-aging.scm | 6 +-
gnucash/report/business-reports/owner-report.scm | 39 +--
gnucash/report/report-system/html-acct-table.scm | 373 +++++++++------------
gnucash/report/report-system/html-text.scm | 3 +
gnucash/report/report-system/report-system.scm | 2 +
gnucash/report/report-system/report-utilities.scm | 31 +-
.../report-system/test/test-report-utilities.scm | 10 +
11 files changed, 227 insertions(+), 332 deletions(-)
More information about the gnucash-changes
mailing list