mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge branch 'maint'
This commit is contained in:
commit
7cdb79ccf2
@ -303,6 +303,25 @@
|
||||
(define (gnc-commodity-collector-allzero? collector)
|
||||
(every zero? (map cdr (collector 'format cons #f))))
|
||||
|
||||
;; (gnc:collector+ collectors ...) equiv to (+ collectors ...) and
|
||||
;; outputs: a collector
|
||||
(define (gnc:collector+ . collectors)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(for-each (lambda (coll) (res 'merge coll #f)) collectors)
|
||||
res))
|
||||
|
||||
;; (gnc:collectors- collectors ...) equiv to (- collectors ...), can
|
||||
;; also negate single-argument collector. outputs collector
|
||||
(define gnc:collector-
|
||||
(case-lambda
|
||||
(() (error "gnc:collector- needs at least 1 collector argument"))
|
||||
((coll) (gnc:collector- (gnc:make-commodity-collector) coll))
|
||||
((coll . rest)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(res 'merge coll #f)
|
||||
(res 'minusmerge (apply gnc:collector+ rest) #f)
|
||||
res))))
|
||||
|
||||
;; add any number of gnc-monetary objects into a commodity-collector
|
||||
;; usage: (gnc:monetaries-add monetary1 monetary2 ...)
|
||||
;; output: a commodity-collector object
|
||||
@ -341,7 +360,7 @@
|
||||
(define (amount->monetary bal)
|
||||
(gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
|
||||
(let loop ((splits (xaccAccountGetSplitList account))
|
||||
(dates-list (stable-sort! dates-list <))
|
||||
(dates-list (sort dates-list <))
|
||||
(currentbal 0)
|
||||
(lastbal 0)
|
||||
(balancelist '()))
|
||||
|
@ -683,6 +683,8 @@
|
||||
(export gnc:accounts-and-all-descendants)
|
||||
(export gnc:make-value-collector)
|
||||
(export gnc:make-commodity-collector)
|
||||
(export gnc:collector+)
|
||||
(export gnc:collector-)
|
||||
(export gnc:commodity-collector-get-negated)
|
||||
(export gnc:account-get-balances-at-dates)
|
||||
(export gnc:account-get-comm-balance-at-date)
|
||||
|
@ -505,11 +505,7 @@
|
||||
(validate (reverse
|
||||
(gnc-account-get-children-sorted
|
||||
(gnc-get-current-root-account))))))
|
||||
(book (if selected-accounts
|
||||
(gnc-account-get-book (if (pair? selected-accounts)
|
||||
(car selected-accounts)
|
||||
selected-accounts))
|
||||
#f))
|
||||
(book (gnc-get-current-book))
|
||||
(generations (if (pair? selected-accounts)
|
||||
(apply max (map (lambda (x) (num-generations x 1))
|
||||
selected-accounts))
|
||||
@ -772,12 +768,7 @@
|
||||
(to-year (gnc-print-time64 to-value "%Y"))
|
||||
(today-date (gnc-print-time64 (time64CanonicalDayTime (current-time))
|
||||
"%d.%m.%Y"))
|
||||
(tax-nr (unless book
|
||||
(or
|
||||
(gnc:option-get-value book gnc:*tax-label* gnc:*tax-nr-label*)
|
||||
"")
|
||||
""))
|
||||
)
|
||||
(tax-nr (gnc:option-get-value book gnc:*tax-label* gnc:*tax-nr-label*)))
|
||||
|
||||
;; Now, the main body
|
||||
;; Reset all the balance collectors
|
||||
|
@ -961,9 +961,8 @@ also show overall period profit & loss."))
|
||||
asset-liability
|
||||
(lambda (acc)
|
||||
(gnc:account-get-comm-value-at-date acc date #f))))
|
||||
(unrealized (gnc:make-commodity-collector)))
|
||||
(unrealized 'merge asset-liability-basis #f)
|
||||
(unrealized 'minusmerge asset-liability-balance #f)
|
||||
(unrealized (gnc:collector- asset-liability-basis
|
||||
asset-liability-balance)))
|
||||
(monetaries->exchanged
|
||||
unrealized common-currency price-source date)))))
|
||||
(retained-earnings-fn
|
||||
|
@ -317,17 +317,6 @@
|
||||
(gnc-budget-get-account-period-actual-value budget acct period))
|
||||
periodlist)))
|
||||
|
||||
(define (flatten lst)
|
||||
(reverse!
|
||||
(let loop ((lst lst) (result '()))
|
||||
(if (null? lst)
|
||||
result
|
||||
(let ((elt (car lst))
|
||||
(rest (cdr lst)))
|
||||
(if (pair? elt)
|
||||
(loop rest (append (loop elt '()) result))
|
||||
(loop rest (cons elt result))))))))
|
||||
|
||||
;; Adds a line to the budget report.
|
||||
;;
|
||||
;; Parameters:
|
||||
@ -342,7 +331,7 @@
|
||||
column-list exchange-fn)
|
||||
(let* ((comm (xaccAccountGetCommodity acct))
|
||||
(reverse-balance? (gnc-reverse-balance acct))
|
||||
(allperiods (filter number? (flatten column-list)))
|
||||
(allperiods (filter number? (gnc:list-flatten column-list)))
|
||||
(total-periods (if accumulate?
|
||||
(iota (1+ (apply max allperiods)))
|
||||
allperiods))
|
||||
@ -396,6 +385,7 @@
|
||||
budget acct total-periods))
|
||||
(act-total (gnc:get-account-periodlist-actual-value
|
||||
budget acct total-periods))
|
||||
(act-total (if reverse-balance? (- act-total) act-total))
|
||||
(dif-total (if income-acct?
|
||||
(- act-total bgt-total)
|
||||
(- bgt-total act-total))))
|
||||
|
@ -336,12 +336,6 @@ developing over time"))
|
||||
c report-currency
|
||||
(lambda (a b) (exchange-fn a b date)))))))
|
||||
|
||||
(define (collector-minus a b)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(coll 'merge a #f)
|
||||
(coll 'minusmerge b #f)
|
||||
coll))
|
||||
|
||||
;; copy of gnc:not-all-zeros using gnc-monetary
|
||||
(define (not-all-zeros data)
|
||||
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
|
||||
@ -396,7 +390,7 @@ developing over time"))
|
||||
(cdr dates-list)
|
||||
(cons (if do-intervals?
|
||||
(collector->monetary
|
||||
(collector-minus (cadr list-of-mon-collectors)
|
||||
(gnc:collector- (cadr list-of-mon-collectors)
|
||||
(car list-of-mon-collectors))
|
||||
(cadr dates-list))
|
||||
(collector->monetary
|
||||
|
@ -261,11 +261,6 @@
|
||||
(member (xaccSplitGetAccount s) accounts))
|
||||
splits))))
|
||||
|
||||
(define (coll-minus minuend subtrahend)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(coll 'merge minuend #f)
|
||||
(coll 'minusmerge subtrahend #f)
|
||||
coll))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@ -347,7 +342,7 @@
|
||||
(sales (gnc:commodity-collector-get-negated
|
||||
(filter-splits splits sales-accounts)))
|
||||
(expense (filter-splits splits expense-accounts))
|
||||
(profit (coll-minus sales expense)))
|
||||
(profit (gnc:collector- sales expense)))
|
||||
(list owner profit sales expense)))
|
||||
ownerlist))
|
||||
(sortingtable '()))
|
||||
@ -402,9 +397,10 @@
|
||||
|
||||
;; Add the "No Customer" lines to the sortingtable for sorting
|
||||
;; as well
|
||||
(let* ((other-sales (coll-minus toplevel-total-sales total-sales))
|
||||
(other-expense (coll-minus toplevel-total-expense total-expense))
|
||||
(other-profit (coll-minus other-sales other-expense)))
|
||||
(let* ((other-sales (gnc:collector- toplevel-total-sales total-sales))
|
||||
(other-expense (gnc:collector- toplevel-total-expense
|
||||
total-expense))
|
||||
(other-profit (gnc:collector- other-sales other-expense)))
|
||||
(for-each
|
||||
(lambda (comm)
|
||||
(let* ((profit (cadr (other-profit 'getpair comm #f)))
|
||||
@ -478,7 +474,8 @@
|
||||
(gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
|
||||
|
||||
;; Summary lines - 1 per currency
|
||||
(let ((total-profit (coll-minus toplevel-total-sales toplevel-total-expense)))
|
||||
(let ((total-profit (gnc:collector- toplevel-total-sales
|
||||
toplevel-total-expense)))
|
||||
(for-each
|
||||
(lambda (comm)
|
||||
(let* ((profit (cadr (total-profit 'getpair comm #f)))
|
||||
|
@ -727,6 +727,7 @@ for styling the invoice. Please see the exported report for the CSS class names.
|
||||
(fax (gnc:company-info book gnc:*company-fax*))
|
||||
(email (gnc:company-info book gnc:*company-email*))
|
||||
(url (gnc:company-info book gnc:*company-url*))
|
||||
(taxnr (gnc:option-get-value book gnc:*tax-label* gnc:*tax-nr-label*))
|
||||
(taxid (gnc:company-info book gnc:*company-id*)))
|
||||
|
||||
(if (and name (not (string-null? name)))
|
||||
@ -764,6 +765,11 @@ for styling the invoice. Please see the exported report for the CSS class names.
|
||||
(gnc:make-html-div/markup
|
||||
"maybe-align-right company-tax-id" taxid))))
|
||||
|
||||
(if (and taxnr (not (string-null? taxnr)))
|
||||
(gnc:html-table-append-row!
|
||||
table (list (gnc:make-html-div/markup
|
||||
"maybe-align-right company-tax-nr" taxnr))))
|
||||
|
||||
table))
|
||||
|
||||
(define (reg-renderer report-obj)
|
||||
|
@ -254,12 +254,6 @@
|
||||
;; conversion function above. Returns a list of gnc-monetary.
|
||||
(define (process-datelist account-balances dates left-col?)
|
||||
|
||||
(define (collector-minus coll1 coll2)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(res 'merge coll1 #f)
|
||||
(res 'minusmerge coll2 #f)
|
||||
res))
|
||||
|
||||
(define accountlist
|
||||
(if inc-exp?
|
||||
(if left-col?
|
||||
@ -297,7 +291,7 @@
|
||||
(cons
|
||||
(collector->monetary
|
||||
(if inc-exp?
|
||||
(collector-minus (car acct-balances) (cadr acct-balances))
|
||||
(gnc:collector- (car acct-balances) (cadr acct-balances))
|
||||
(car acct-balances))
|
||||
(if inc-exp? (cadr dates) (car dates)))
|
||||
result)))))
|
||||
|
@ -746,8 +746,8 @@
|
||||
(end-date (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(opt-val gnc:pagename-general optname-to-date))))
|
||||
(book (gnc-account-get-book account))
|
||||
(date-format (if (not (null? book)) (gnc:options-fancy-date book)))
|
||||
(book (gnc-get-current-book))
|
||||
(date-format (gnc:options-fancy-date book))
|
||||
(type (opt-val "__reg" "owner-type"))
|
||||
(owner-descr (owner-string type))
|
||||
(date-type (opt-val gnc:pagename-general optname-date-driver))
|
||||
|
@ -62,13 +62,15 @@
|
||||
(define (test-trial-balance)
|
||||
(let* ((options (gnc:make-report-options uuid))
|
||||
(account-alist (create-test-data))
|
||||
(gbp-bank (assoc-ref account-alist "GBP Bank"))
|
||||
(usd-bank (assoc-ref account-alist "Bank"))
|
||||
(expense (assoc-ref account-alist "Expenses"))
|
||||
(equity (assoc-ref account-alist "Equity"))
|
||||
(income (assoc-ref account-alist "Income"))
|
||||
(bank (assoc-ref account-alist "Bank")))
|
||||
|
||||
(gnc-commodity-set-user-symbol
|
||||
(xaccAccountGetCommodity (assoc-ref account-alist "GBP Bank"))
|
||||
(xaccAccountGetCommodity gbp-bank)
|
||||
"#")
|
||||
|
||||
(let ((closing-txn (env-transfer #f 30 06 2003 expense equity
|
||||
@ -167,6 +169,18 @@
|
||||
(sxml->table-row-col sxml 1 #f 10))
|
||||
|
||||
(test-equal "work-sheet bs credits"
|
||||
' ("$3.00" "$2,356.00" "$2,359.00" "$760.00" "$3,119.00")
|
||||
'("$3.00" "$2,356.00" "$2,359.00" "$760.00" "$3,119.00")
|
||||
(sxml->table-row-col sxml 1 #f 11)))
|
||||
))
|
||||
|
||||
;; A couple of transactions which involve foreign currency
|
||||
;; conversions. We'll set the currencies to GBP and USD.
|
||||
(env-transfer-foreign #f 15 01 2000 gbp-bank usd-bank
|
||||
10 14 #:description "GBP 10 to USD 14")
|
||||
(env-transfer-foreign #f 15 02 2000 usd-bank gbp-bank
|
||||
9 8 #:description "USD 9 to GBP 8")
|
||||
|
||||
(set-option options "General" "Report variation" 'current)
|
||||
(let ((sxml (options->sxml options "test-unrealized-gain")))
|
||||
(test-equal "unrealized losses"
|
||||
'("Unrealized Gains" "$3.25")
|
||||
(sxml->table-row-col sxml 1 -2 #f)))))
|
||||
|
@ -152,9 +152,7 @@
|
||||
(amt (and sum (gnc:gnc-monetary-amount sum)))
|
||||
(neg? (and amt (negative? amt)))
|
||||
(bal (if neg?
|
||||
(let ((bal (gnc:make-commodity-collector)))
|
||||
(bal 'minusmerge signed-balance #f)
|
||||
bal)
|
||||
(gnc:commodity-collector-get-negated signed-balance)
|
||||
signed-balance))
|
||||
(bal-sum (gnc:sum-collector-commodity
|
||||
bal
|
||||
@ -512,36 +510,21 @@
|
||||
;;
|
||||
;; This procedure returns a commodity collector.
|
||||
(define (collect-unrealized-gains)
|
||||
(define (acct->bal acct)
|
||||
(gnc:account-get-comm-balance-at-date acct end-date #f))
|
||||
(if (eq? price-source 'average-cost)
|
||||
;; No need to calculate if doing valuation at cost.
|
||||
(gnc:make-commodity-collector)
|
||||
(let ((book-balance (gnc:make-commodity-collector))
|
||||
(unrealized-gain-collector (gnc:make-commodity-collector))
|
||||
(cost-fn (gnc:case-exchange-fn
|
||||
'average-cost report-commodity end-date)))
|
||||
|
||||
;; Calculate book balance.
|
||||
;; assets - liabilities - equity; normally 0
|
||||
(for-each
|
||||
(lambda (acct)
|
||||
(book-balance
|
||||
'merge
|
||||
(gnc:account-get-comm-balance-at-date acct end-date #f)
|
||||
#f))
|
||||
all-accounts)
|
||||
|
||||
(let ((value (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
book-balance report-commodity exchange-fn)))
|
||||
(cost (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
book-balance report-commodity cost-fn))))
|
||||
|
||||
(let* ((cost-fn (gnc:case-exchange-fn
|
||||
'average-cost report-commodity end-date))
|
||||
(acct-balances (map acct->bal all-accounts))
|
||||
(book-balance (apply gnc:collector+ acct-balances))
|
||||
(value (gnc:sum-collector-commodity
|
||||
book-balance report-commodity exchange-fn))
|
||||
(cost (gnc:sum-collector-commodity
|
||||
book-balance report-commodity cost-fn)))
|
||||
;; Get the unrealized gain or loss (value minus cost).
|
||||
(unrealized-gain-collector
|
||||
'add report-commodity (- value cost))
|
||||
unrealized-gain-collector))))
|
||||
|
||||
(gnc:monetaries-add value (gnc:monetary-neg cost)))))
|
||||
|
||||
;; set default cell alignment
|
||||
(gnc:html-table-set-style!
|
||||
@ -667,12 +650,6 @@
|
||||
splits)
|
||||
total))
|
||||
|
||||
(define (coll-minus . collectors)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(res 'merge (car collectors) #f)
|
||||
(for-each (lambda (mon) (res 'minusmerge mon #f)) (cdr collectors))
|
||||
res))
|
||||
|
||||
(while (< row rows)
|
||||
(let* ((env (gnc:html-acct-table-get-row-env acct-table row))
|
||||
(acct (get-val env 'account))
|
||||
@ -684,21 +661,19 @@
|
||||
(pos-adjusting
|
||||
(and ga-or-is? (sum-account-splits acct adjusting-splits #t)))
|
||||
(neg-adjusting
|
||||
(and ga-or-is? (coll-minus adjusting pos-adjusting)))
|
||||
(pre-closing-bal (coll-minus curr-bal closing))
|
||||
(pre-adjusting-bal (coll-minus pre-closing-bal adjusting))
|
||||
(atb (if is?
|
||||
(let* ((debit (gnc:make-commodity-collector))
|
||||
(credit (gnc:make-commodity-collector)))
|
||||
(debit 'merge pos-adjusting #f)
|
||||
(credit 'merge neg-adjusting #f)
|
||||
(if (double-col
|
||||
'credit-q pre-adjusting-bal
|
||||
(and ga-or-is? (gnc:collector- adjusting pos-adjusting)))
|
||||
(pre-closing-bal (gnc:collector- curr-bal closing))
|
||||
(pre-adjusting-bal (gnc:collector- pre-closing-bal
|
||||
adjusting))
|
||||
(atb (cond ((not is?) pre-closing-bal)
|
||||
((double-col 'credit-q pre-adjusting-bal
|
||||
report-commodity exchange-fn show-fcur?)
|
||||
(credit 'merge pre-adjusting-bal #f)
|
||||
(debit 'merge pre-adjusting-bal #f))
|
||||
(list debit credit))
|
||||
pre-closing-bal)))
|
||||
(list (gnc:collector+ pos-adjusting)
|
||||
(gnc:collector+ neg-adjusting
|
||||
pre-adjusting-bal)))
|
||||
(else
|
||||
(list (gnc:collector+ pos-adjusting pre-adjusting-bal)
|
||||
(gnc:collector+ neg-adjusting))))))
|
||||
|
||||
;; curr-bal = account-bal with closing & adj entries
|
||||
;; pre-closing-bal = account-bal with adj entries only
|
||||
@ -865,8 +840,8 @@
|
||||
(tot-abs-amt-cell bs-credits))
|
||||
'())))
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let* ((net-is (gnc:make-commodity-collector))
|
||||
(net-bs (gnc:make-commodity-collector))
|
||||
(let* ((net-is (gnc:collector- is-debits is-credits))
|
||||
(net-bs (gnc:collector- bs-debits bs-credits))
|
||||
(tot-is (gnc:make-commodity-collector))
|
||||
(tot-bs (gnc:make-commodity-collector))
|
||||
(is-entry #f)
|
||||
@ -875,10 +850,6 @@
|
||||
(bs-credit? #f)
|
||||
(tbl-width (+ account-cols (* 2 bs-col) 2))
|
||||
(this-row (gnc:html-table-num-rows build-table)))
|
||||
(net-is 'merge is-debits #f)
|
||||
(net-is 'minusmerge is-credits #f)
|
||||
(net-bs 'merge bs-debits #f)
|
||||
(net-bs 'minusmerge bs-credits #f)
|
||||
(set! is-entry
|
||||
(double-col 'entry net-is report-commodity exchange-fn show-fcur?))
|
||||
(set! is-credit?
|
||||
|
@ -212,6 +212,21 @@
|
||||
(gnc:make-gnc-monetary USD 25)
|
||||
(coll-A 'getmonetary USD #f))
|
||||
|
||||
(test-equal "gnc:collector+"
|
||||
'(("USD" . 50) ("GBP" . -20))
|
||||
(collector->list
|
||||
(gnc:collector+ coll-A coll-A coll-B)))
|
||||
|
||||
(test-equal "gnc:collector- 1 arg"
|
||||
'(("GBP" . 20) ("USD" . -25))
|
||||
(collector->list
|
||||
(gnc:collector- coll-A)))
|
||||
|
||||
(test-equal "gnc:collector- 3 args"
|
||||
'(("USD" . 25) ("GBP" . -60))
|
||||
(collector->list
|
||||
(gnc:collector- coll-A coll-B coll-B)))
|
||||
|
||||
(test-equal "gnc:commodity-collector-get-negated"
|
||||
'(("USD" . -25) ("GBP" . 20))
|
||||
(collector->list
|
||||
|
@ -276,6 +276,8 @@
|
||||
(define gnc:*company-contact* (N_ "Company Contact Person"))
|
||||
(define gnc:*fancy-date-label* (N_ "Fancy Date Format"))
|
||||
(define gnc:*fancy-date-format* (N_ "custom"))
|
||||
(define gnc:*tax-label* (N_ "Tax"))
|
||||
(define gnc:*tax-nr-label* (N_ "Tax Number"))
|
||||
|
||||
(define (gnc:company-info book key)
|
||||
;; Access company info from key-value pairs for current book
|
||||
@ -304,6 +306,7 @@
|
||||
gnc:*option-name-currency-accounting* gnc:*option-name-book-currency*
|
||||
gnc:*option-name-default-gains-policy*
|
||||
gnc:*option-name-default-gain-loss-account*
|
||||
gnc:*tax-label* gnc:*tax-nr-label*
|
||||
gnc:*option-name-auto-readonly-days* gnc:*option-name-num-field-source*)
|
||||
|
||||
(define gnc:*option-section-budgeting* OPTION-SECTION-BUDGETING)
|
||||
|
@ -157,6 +157,12 @@
|
||||
gnc:*option-section-budgeting* gnc:*option-name-default-budget*
|
||||
"a" (N_ "Budget to be used when none has been otherwise specified.")))
|
||||
|
||||
;; Tax Tab
|
||||
(reg-option
|
||||
(gnc:make-string-option
|
||||
gnc:*tax-label* gnc:*tax-nr-label*
|
||||
"a" (N_ "The electronic tax number of your business") ""))
|
||||
|
||||
;; Counters Tab
|
||||
(for-each
|
||||
(lambda (vals)
|
||||
|
@ -10,6 +10,7 @@
|
||||
(test-traverse-vec)
|
||||
(test-substring-replace)
|
||||
(test-sort-and-delete-duplicates)
|
||||
(test-gnc:list-flatten)
|
||||
(test-begin "test-libgnucash-scm-utilities.scm"))
|
||||
|
||||
(define (test-traverse-vec)
|
||||
@ -87,3 +88,14 @@
|
||||
'(1 2 3)
|
||||
(sort-and-delete-duplicates '(3 1 2) <))
|
||||
(test-end "sort-and-delete-duplicates"))
|
||||
|
||||
(define (test-gnc:list-flatten)
|
||||
(test-equal "gnc:list-flatten null"
|
||||
'()
|
||||
(gnc:list-flatten '()))
|
||||
(test-equal "gnc:list-flatten noop"
|
||||
'(1 2 3)
|
||||
(gnc:list-flatten '(1 2 3)))
|
||||
(test-equal "gnc:list-flatten deep"
|
||||
'(1 2 3 4 5 6)
|
||||
(gnc:list-flatten '(1 (2) (() () (((((3))) ())) 4 () ((5) (6)))))))
|
||||
|
@ -47,6 +47,7 @@
|
||||
(export gnc:debug)
|
||||
(export addto!)
|
||||
(export sort-and-delete-duplicates)
|
||||
(export gnc:list-flatten)
|
||||
|
||||
;; Do this stuff very early -- but other than that, don't add any
|
||||
;; executable code until the end of the file if you can help it.
|
||||
@ -191,6 +192,17 @@
|
||||
(define (kons a b) (if (and (pair? b) (= a (car b))) b (cons a b)))
|
||||
(reverse (fold kons '() (sort lst <))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; flattens an arbitrary deep nested list into simple list. this is
|
||||
;; probably the most efficient algorithm available. '(1 2 (3 4)) -->
|
||||
;; '(1 2 3 4)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (gnc:list-flatten . lst)
|
||||
(reverse
|
||||
(let lp ((e lst) (accum '()))
|
||||
(if (list? e)
|
||||
(fold lp accum e)
|
||||
(cons e accum)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; compatibility hack for fixing guile-2.0 string handling. this code
|
||||
|
@ -49,10 +49,5 @@
|
||||
(export txf-asset-categories)
|
||||
(export txf-liab-eq-categories)
|
||||
|
||||
(define gnc:*tax-label* (N_ "Tax"))
|
||||
(define gnc:*tax-nr-label* (N_ "Tax Number"))
|
||||
|
||||
(export gnc:*tax-label* gnc:*tax-nr-label*)
|
||||
|
||||
(load-from-path "gnucash/locale/de_DE/tax/txf")
|
||||
(load-from-path "gnucash/locale/de_DE/tax/txf-help")
|
||||
|
@ -312,16 +312,3 @@ Fehlermeldungen + Dankschreiben an: stoll@bomhardt.de"))
|
||||
)
|
||||
)
|
||||
))
|
||||
|
||||
;;; Register global options in this book
|
||||
(define (book-options-generator options)
|
||||
(define (reg-option new-option)
|
||||
(gnc:register-option options new-option))
|
||||
|
||||
(reg-option
|
||||
(gnc:make-string-option
|
||||
gnc:*tax-label* gnc:*tax-nr-label*
|
||||
"a" (N_ "The electronic tax number of your business") ""))
|
||||
)
|
||||
|
||||
(gnc-register-kvp-option-generator QOF-ID-BOOK-SCM book-options-generator)
|
||||
|
Loading…
Reference in New Issue
Block a user