[Gnucash-changes] r14034 - gnucash/trunk/src - Fixing bug #341589:
Apparently, guile 1.8 will actually enforce the rule
Chris Shoemaker
chris at cvs.gnucash.org
Sat May 13 00:52:10 EDT 2006
Author: chris
Date: 2006-05-13 00:52:09 -0400 (Sat, 13 May 2006)
New Revision: 14034
Trac: http://svn.gnucash.org/trac/changeset/14034
Modified:
gnucash/trunk/src/report/report-system/commodity-utilities.scm
gnucash/trunk/src/report/report-system/report-utilities.scm
gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
gnucash/trunk/src/report/standard-reports/portfolio.scm
gnucash/trunk/src/report/standard-reports/price-scatter.scm
gnucash/trunk/src/report/standard-reports/transaction.scm
gnucash/trunk/src/scm/gnumeric/table-utils.scm
Log:
Fixing bug #341589: Apparently, guile 1.8 will actually enforce the rule
that all datum portions of case-statement clauses be unique. The syntax:
'foo expands to a list of two symbols: (quote foo)
If both 'foo and 'bar are used, then the "quote" symbol won't be unique.
Modified: gnucash/trunk/src/report/report-system/commodity-utilities.scm
===================================================================
--- gnucash/trunk/src/report/report-system/commodity-utilities.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/report-system/commodity-utilities.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -821,14 +821,15 @@
(define (gnc:case-exchange-fn
source-option report-currency to-date-tp)
(case source-option
- ('weighted-average (gnc:make-exchange-function
+ ((weighted-average) (gnc:make-exchange-function
(gnc:make-exchange-alist
report-currency to-date-tp)))
- ('pricedb-latest gnc:exchange-by-pricedb-latest)
- ('pricedb-nearest (lambda (foreign domestic)
+ ((pricedb-latest) gnc:exchange-by-pricedb-latest)
+ ((pricedb-nearest) (lambda (foreign domestic)
(gnc:exchange-by-pricedb-nearest
foreign domestic to-date-tp)))
- (else (gnc:warn "gnc:case-exchange-fn: bad price-source value"))))
+ (else (gnc:warn "gnc:case-exchange-fn: bad price-source value: "
+ source-option))))
;; Return a ready-to-use function. Which one to use is determined by
;; the value of 'source-option', whose possible values are set in
@@ -841,23 +842,24 @@
source-option report-currency commodity-list to-date-tp
start-percent delta-percent)
(case source-option
- ('weighted-average (let ((pricealist
+ ((weighted-average) (let ((pricealist
(gnc:get-commoditylist-totalavg-prices
commodity-list report-currency to-date-tp
start-percent delta-percent)))
(lambda (foreign domestic date)
(gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date))))
- ('actual-transactions (let ((pricealist
+ ((actual-transactions) (let ((pricealist
(gnc:get-commoditylist-inst-prices
commodity-list report-currency to-date-tp)))
(lambda (foreign domestic date)
(gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date))))
- ('pricedb-latest (lambda (foreign domestic date)
+ ((pricedb-latest) (lambda (foreign domestic date)
(gnc:exchange-by-pricedb-latest foreign domestic)))
- ('pricedb-nearest gnc:exchange-by-pricedb-nearest)
- (else (gnc:warn "gnc:case-exchange-time-fn: bad price-source value"))))
+ ((pricedb-nearest) gnc:exchange-by-pricedb-nearest)
+ (else (gnc:warn "gnc:case-exchange-time-fn: bad price-source value: "
+ source-option))))
Modified: gnucash/trunk/src/report/report-system/report-utilities.scm
===================================================================
--- gnucash/trunk/src/report/report-system/report-utilities.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/report-system/report-utilities.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -247,13 +247,13 @@
(set! totalitems 0))))
(lambda (action value) ;;; Dispatch function
(case action
- ('add (adder value))
- ('total (gettotal))
- ('average (getaverage))
- ('numitems (getnumitems))
- ('getmax (getmax))
- ('getmin (getmin))
- ('reset (reset-all))
+ ((add) (adder value))
+ ((total) (gettotal))
+ ((average) (getaverage))
+ ((numitems) (getnumitems))
+ ((getmax) (getmax))
+ ((getmin) (getmin))
+ ((reset) (reset-all))
(else (gnc:warn "bad stats-collector action: " action)))))))
(define (gnc:make-drcr-collector)
@@ -278,11 +278,11 @@
(set! totalitems 0))))
(lambda (action value) ;;; Dispatch function
(case action
- ('add (adder value))
- ('debits (getdebits))
- ('credits (getcredits))
- ('items (getitems))
- ('reset (reset-all))
+ ((add) (adder value))
+ ((debits) (getdebits))
+ ((credits) (getcredits))
+ ((items) (getitems))
+ ((reset) (reset-all))
(else (gnc:warn "bad dr-cr-collector action: " action)))))))
;; This is a collector of values -- works similar to the stats-collector but
@@ -292,9 +292,9 @@
((value 0))
(lambda (action amount) ;;; Dispatch function
(case action
- ('add (if (number? amount)
+ ((add) (if (number? amount)
(set! value (+ amount value))))
- ('total value)
+ ((total) value)
(else (gnc:warn "bad value-collector action: " action))))))
;; Bah. Let's get back to normal data types -- this procedure thingy
;; from above makes every code almost unreadable. First step: replace
@@ -311,12 +311,13 @@
((value (gnc:numeric-zero)))
(lambda (action amount) ;;; Dispatch function
(case action
- ('add (if (gnc:gnc-numeric? amount)
+ ((add) (if (gnc:gnc-numeric? amount)
(set! value (gnc:numeric-add-fixed amount value))
(gnc:warn
"gnc:numeric-collector called with wrong argument: " amount)))
- ('total value)
+ ((total) value)
(else (gnc:warn "bad gnc:numeric-collector action: " action))))))
+
;; Replace all 'action function calls by the normal functions below.
(define (gnc:numeric-collector-add collector amount)
(collector 'add amount))
@@ -435,16 +436,16 @@
;; Dispatch function
(lambda (action commodity amount)
(case action
- ('add (add-commodity-value commodity amount))
- ('merge (add-commodity-clist
+ ((add) (add-commodity-value commodity amount))
+ ((merge) (add-commodity-clist
(gnc:commodity-collector-list commodity)))
- ('minusmerge (minus-commodity-clist
+ ((minusmerge) (minus-commodity-clist
(gnc:commodity-collector-list commodity)))
- ('format (process-commodity-list commodity commoditylist))
- ('reset (set! commoditylist '()))
- ('getpair (getpair commodity amount))
- ('getmonetary (getmonetary commodity amount))
- ('list commoditylist) ; this one is only for internal use
+ ((format) (process-commodity-list commodity commoditylist))
+ ((reset) (set! commoditylist '()))
+ ((getpair) (getpair commodity amount))
+ ((getmonetary) (getmonetary commodity amount))
+ ((list) commoditylist) ; this one is only for internal use
(else (gnc:warn "bad commodity-collector action: " action))))))
Modified: gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -204,44 +204,58 @@
(define (basis-builder b-list b-units b-value b-method)
(if (gnc:numeric-positive-p b-units)
(case b-method
- ('average-basis (if (not (eqv? b-list '()))
- (list (cons (gnc:numeric-add b-units (caar b-list) 10000 GNC-RND-ROUND)
- (gnc:numeric-div (gnc:numeric-add b-value
- (gnc:numeric-mul (caar b-list)
- (cdar b-list)
- 10000 GNC-RND-ROUND)
- 10000 GNC-RND-ROUND)
- (gnc:numeric-add b-units (caar b-list) 10000 GNC-RND-ROUND)
- 10000 GNC-RND-ROUND)))
- (append b-list (list (cons b-units (gnc:numeric-div b-value b-units 10000 GNC-RND-ROUND))))
- )
- )
- (else (append b-list (list (cons b-units (gnc:numeric-div b-value b-units 10000 GNC-RND-ROUND)))))
- )
+ ((average-basis)
+ (if (not (eqv? b-list '()))
+ (list (cons (gnc:numeric-add b-units
+ (caar b-list) 10000 GNC-RND-ROUND)
+ (gnc:numeric-div
+ (gnc:numeric-add b-value
+ (gnc:numeric-mul (caar b-list)
+ (cdar b-list)
+ 10000 GNC-RND-ROUND)
+ 10000 GNC-RND-ROUND)
+ (gnc:numeric-add b-units
+ (caar b-list) 10000 GNC-RND-ROUND)
+ 10000 GNC-RND-ROUND)))
+ (append b-list
+ (list (cons b-units (gnc:numeric-div
+ b-value b-units 10000
+ GNC-RND-ROUND))))))
+ (else (append b-list
+ (list (cons b-units (gnc:numeric-div
+ b-value b-units 10000
+ GNC-RND-ROUND))))))
(if (not (eqv? b-list '()))
(case b-method
- ('fifo-basis (if (not (= -1 (gnc:numeric-compare (gnc:numeric-abs b-units) (caar b-list))))
- (basis-builder (cdr b-list) (gnc:numeric-add
- b-units
- (caar b-list) 10000 GNC-RND-ROUND)
- b-value b-method)
- (append (list (cons (gnc:numeric-add
- b-units
- (caar b-list) 10000 GNC-RND-ROUND)
- (cdar b-list))) (cdr b-list))))
- ('filo-basis (if (not (= -1 (gnc:numeric-compare (gnc:numeric-abs b-units) (caar (reverse b-list)))))
- (basis-builder (reverse (cdr (reverse b-list))) (gnc:numeric-add
- b-units
- (caar (reverse b-list))
- 10000 GNC-RND-ROUND)
- b-value b-method)
- (append (cdr (reverse b-list)) (list (cons (gnc:numeric-add
- b-units
- (caar (reverse b-list)) 10000 GNC-RND-ROUND)
- (cdar (reverse b-list)))))))
- ('average-basis (list (cons (gnc:numeric-add (caar b-list) b-units 10000 GNC-RND-ROUND)
- (cdar b-list))))
- )
+ ((fifo-basis)
+ (if (not (= -1 (gnc:numeric-compare
+ (gnc:numeric-abs b-units) (caar b-list))))
+ (basis-builder (cdr b-list) (gnc:numeric-add
+ b-units
+ (caar b-list) 10000 GNC-RND-ROUND)
+ b-value b-method)
+ (append (list (cons (gnc:numeric-add
+ b-units
+ (caar b-list) 10000 GNC-RND-ROUND)
+ (cdar b-list))) (cdr b-list))))
+ ((filo-basis)
+ (if (not (= -1 (gnc:numeric-compare
+ (gnc:numeric-abs b-units) (caar (reverse b-list)))))
+ (basis-builder (reverse (cdr (reverse b-list)))
+ (gnc:numeric-add
+ b-units
+ (caar (reverse b-list))
+ 10000 GNC-RND-ROUND)
+ b-value b-method)
+ (append (cdr (reverse b-list))
+ (list (cons (gnc:numeric-add
+ b-units
+ (caar (reverse b-list)) 10000 GNC-RND-ROUND)
+ (cdar (reverse b-list)))))))
+ ((average-basis)
+ (list (cons (gnc:numeric-add
+ (caar b-list) b-units 10000 GNC-RND-ROUND)
+ (cdar b-list)))))
'()
)
)
@@ -581,14 +595,14 @@
(pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
(price-fn
(case price-source
- ('pricedb-latest
+ ((pricedb-latest)
(lambda (foreign date)
(gnc:pricedb-lookup-latest-any-currency pricedb foreign)))
- ('pricedb-nearest
+ ((pricedb-nearest)
(lambda (foreign date)
(gnc:pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (gnc:timepair-canonical-day-time date))))
- ('pricedb-latest-before
+ ((pricedb-latest-before)
(lambda (foreign date)
(gnc:pricedb-lookup-latest-before-any-currency
pricedb foreign (gnc:timepair-canonical-day-time date))))))
Modified: gnucash/trunk/src/report/standard-reports/portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/portfolio.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/standard-reports/portfolio.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -196,14 +196,14 @@
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
(case price-source
- ('weighted-average
+ ((weighted-average)
(let ((pricealist
(gnc:get-commoditylist-totalavg-prices
commodity-list currency to-date 0 0)))
(lambda (foreign date)
(cons #f (gnc:pricealist-lookup-nearest-in-time
pricealist foreign date)))))
- ('pricedb-latest
+ ((pricedb-latest)
(lambda (foreign date)
(let ((price
(gnc:pricedb-lookup-latest-any-currency
@@ -212,7 +212,7 @@
(let ((v (gnc:price-get-value (car price))))
(cons (car price) v))
(cons #f (gnc:numeric-zero))))))
- ('pricedb-nearest
+ ((pricedb-nearest)
(lambda (foreign date)
(let ((price
(gnc:pricedb-lookup-nearest-in-time-any-currency
Modified: gnucash/trunk/src/report/standard-reports/price-scatter.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/price-scatter.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/standard-reports/price-scatter.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -192,22 +192,22 @@
(gnc:html-scatter-set-height! chart height)
(gnc:html-scatter-set-marker! chart
(case marker
- ('circle "circle")
- ('cross "cross")
- ('square "square")
- ('asterisk "asterisk")
- ('filledcircle "filled circle")
- ('filledsquare "filled square")))
+ ((circle) "circle")
+ ((cross) "cross")
+ ((square) "square")
+ ((asterisk) "asterisk")
+ ((filledcircle) "filled circle")
+ ((filledsquare) "filled square")))
(gnc:html-scatter-set-markercolor! chart mcolor)
(gnc:html-scatter-set-y-axis-label!
chart (gnc:commodity-get-mnemonic report-currency))
(gnc:html-scatter-set-x-axis-label!
chart (case interval
- ('DayDelta (N_ "Days"))
- ('WeekDelta (N_ "Weeks"))
- ('TwoWeekDelta (N_ "Double-Weeks"))
- ('MonthDelta (N_ "Months"))
- ('YearDelta (N_ "Years"))))
+ ((DayDelta) (N_ "Days"))
+ ((WeekDelta) (N_ "Weeks"))
+ ((TwoWeekDelta) (N_ "Double-Weeks"))
+ ((MonthDelta) (N_ "Months"))
+ ((YearDelta) (N_ "Years"))))
(if
(not (gnc:commodity-equiv? report-currency price-commodity))
@@ -216,15 +216,15 @@
(set!
data
(case price-source
- ('actual-transactions
+ ((actual-transactions)
(gnc:get-commodity-inst-prices
currency-accounts to-date-tp
price-commodity report-currency))
- ('weighted-average
+ ((weighted-average)
(gnc:get-commodity-totalavg-prices
currency-accounts to-date-tp
price-commodity report-currency))
- ('pricedb
+ ((pricedb)
(map (lambda (p)
(list (gnc:price-get-time p)
(gnc:price-get-value p)))
@@ -264,11 +264,11 @@
;; scaling thing is totally bogus as well,
;; so this doesn't matter too much.
(case interval
- ('DayDelta 86400)
- ('WeekDelta 604800)
- ('TwoWeekDelta 1209600)
- ('MonthDelta 2628000)
- ('YearDelta 31536000)))
+ ((DayDelta) 86400)
+ ((WeekDelta) 604800)
+ ((TwoWeekDelta) 1209600)
+ ((MonthDelta) 2628000)
+ ((YearDelta) 31536000)))
(second x)))
data))
Modified: gnucash/trunk/src/report/standard-reports/transaction.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/transaction.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/report/standard-reports/transaction.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -1293,9 +1293,9 @@
#t)
(case void-status
- (('non-void-only)
+ ((non-void-only)
(gnc:query-set-match-non-voids-only! query (gnc:get-current-book)))
- (('void-only)
+ ((void-only)
(gnc:query-set-match-voids-only! query (gnc:get-current-book)))
(else #f))
Modified: gnucash/trunk/src/scm/gnumeric/table-utils.scm
===================================================================
--- gnucash/trunk/src/scm/gnumeric/table-utils.scm 2006-05-12 20:56:26 UTC (rev 14033)
+++ gnucash/trunk/src/scm/gnumeric/table-utils.scm 2006-05-13 04:52:09 UTC (rev 14034)
@@ -17,11 +17,11 @@
(set! count 0))))
(lambda (action value . rowdata)
(case action
- ('add (adder value rowdata))
- ('total (gettotal))
- ('getcount (getcount))
- ('getrows (getrows))
- ('reset (resetall)))))))
+ ((add) (adder value rowdata))
+ ((total) (gettotal))
+ ((getcount) (getcount))
+ ((getrows) (getrows))
+ ((reset) (resetall)))))))
;;; Here's how it looks:
; > (define a (make-table-collector))
More information about the gnucash-changes
mailing list