Op 18-sep-2007, om 15:46 heeft Derek Atkins het volgende geschreven:
Johan van Oostrum <[EMAIL PROTECTED]> writes:
My svn diff does not accept the -x -b switches (svn, version 1.3.2
(r19776) compiled Jun 5 2006, 13:13:11)
So created the (attached) diff as follows using GNU Diff (on Mac OS X
10.4.10):
svn diff --diff-cmd /usr/bin/diff -x "-b" -r 81:83 ~/Documents/svn/
my_gnucash_reports/branches/advanced-portfolio.scm >
~/Desktop/diff.txt
This results in < and > indicator instead of the - and + as in svn
diff. Hope this is ok too?
Ahh, could you use "-x -ub" then? The > and < make it impossible
to apply the patch.
Ok, that option did it! Hope that the attached diff is a useful one.
Index:
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
===================================================================
---
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
(revision 81)
+++
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
(revision 84)
@@ -39,6 +39,7 @@
(define reportname (N_ "Advanced Portfolio"))
(define optname-price-source (N_ "Price Source"))
+(define optname-sort-column (N_ "Sort Column"))
(define optname-shares-digits (N_ "Share decimal places"))
(define optname-zero-shares (N_ "Include accounts with no shares"))
(define optname-include-gains (N_ "Include gains and losses"))
@@ -64,7 +65,27 @@
(N_ "Date") "a")
(gnc:options-add-currency!
- options gnc:pagename-general (N_ "Report Currency") "c")
+ options gnc:pagename-general (N_ "Report Currency") "b")
+
+ (add-option
+ (gnc:make-multichoice-option
+ gnc:pagename-general optname-sort-column
+ "c" (N_ "The column on which the report is sorted") '0
+ (list (vector '0 (N_ "Account") (N_ ""))
+ (vector '1 (N_ "Symbol") (N_ ""))
+ (vector '2 (N_ "Listing") (N_ ""))
+ (vector '3 (N_ "Shares") (N_ ""))
+ (vector '4 (N_ "Price") (N_ ""))
+ (vector '5 (N_ "Tick") (N_ "")) ;; use-txn tick
+ (vector '6 (N_ "Basis") (N_ ""))
+ (vector '7 (N_ "Value") (N_ ""))
+ (vector '8 (N_ "Money In") (N_ ""))
+ (vector '9 (N_ "Money Out") (N_ ""))
+ (vector '10 (N_ "Realized Gain") (N_ ""))
+ (vector '11 (N_ "Unrealized Gain") (N_ ""))
+ (vector '12 (N_ "Total Gain") (N_ ""))
+ (vector '13 (N_ "Total Return") (N_ ""))
+ )))
(add-option
(gnc:make-multichoice-option
@@ -102,7 +123,6 @@
(N_ "Prefer use of price editor pricing over transactions, where
applicable.")
#t))
-
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -110,6 +130,7 @@
(N_ "Include splits with no shares for calculating money-in and
money-out")
#f))
+ ;; Show Tab
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -144,7 +165,7 @@
(N_ "Display share prices")
#t))
- ;; Account tab
+ ;; Account Tab
(add-option
(gnc:make-account-list-option
gnc:pagename-accounts (N_ "Accounts")
@@ -173,7 +194,6 @@
;; includes all the relevant Scheme code. The option database passed
;; to the function is one created by the options-generator function
;; defined above.
-
(define (advanced-portfolio-renderer report-obj)
(let ((work-done 0)
@@ -277,22 +297,18 @@
)
)
-
-(define (table-add-stock-rows table accounts to-date
+ ;; return list with computed values for all selected stocks
+ (define (table-add-stock-rows accounts to-date
currency price-fn exchange-fn
include-empty include-gains show-symbol
show-listing show-shares show-price
basis-method prefer-pricelist total-basis
total-value total-moneyin total-moneyout
total-gain total-ugain)
- (let ((share-print-info
- (gnc-share-print-info-places
- (inexact->exact (get-option gnc:pagename-display
- optname-shares-digits)))))
+ (let ()
- (define (table-add-stock-rows-internal accounts odd-row?)
- (if (null? accounts) total-value
- (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
- (current (car accounts))
+ (define (table-add-stock-rows-internal accounts)
+ (if (null? accounts) (list) ;; return empty list
+ (let* ((current (car accounts))
(rest (cdr accounts))
(name (xaccAccountGetName current))
(commodity (xaccAccountGetCommodity current))
@@ -301,7 +317,7 @@
(unit-collector (gnc:account-get-comm-balance-at-date
current to-date #f))
(units (cadr (unit-collector 'getpair commodity #f)))
-;; (totalunits 0.0) ;; these two items do nothing, but
are in a debug below,
+ ;; (totalunits 0.0) ;; these two
items do nothing, but are in a debug below,
;; (totalunityears 0.0);; so I'm leaving it. asw
;; Counter to keep track of stuff
@@ -312,7 +328,6 @@
(moneyoutcoll (gnc:make-commodity-collector))
(gaincoll (gnc:make-commodity-collector))
-
(price-list (price-fn commodity to-date))
(price (if (> (length price-list) 0)
(car price-list) #f))
@@ -329,8 +344,7 @@
(txn-units (gnc-numeric-zero))
)
-
-;; (gnc:debug "---" name "---")
+ ;; (gnc:debug "---" name "---")
(for-each
(lambda (split)
(set! work-done (+ 1 work-done))
@@ -376,31 +390,31 @@
(lambda (s)
(cond
((same-split? s split)
-;; (gnc:debug "amount " (gnc-numeric-to-double
(xaccSplitGetAmount s))
-;; " acct " (xaccAccountGetName
(xaccSplitGetAccount s)) )
-;; (gnc:debug "value " (gnc-numeric-to-double
(xaccSplitGetValue s))
-;; " in " (gnc-commodity-get-printname
commod-currency)
-;; " from " (xaccTransGetDescription
(xaccSplitGetParent s)))
+ ;; (gnc:debug "amount "
(gnc-numeric-to-double (xaccSplitGetAmount s))
+ ;; " acct "
(xaccAccountGetName (xaccSplitGetAccount s)) )
+ ;; (gnc:debug "value "
(gnc-numeric-to-double (xaccSplitGetValue s))
+ ;; " in "
(gnc-commodity-get-printname commod-currency)
+ ;; " from "
(xaccTransGetDescription (xaccSplitGetParent s)))
(cond
((or include-gains (not (gnc-numeric-zero-p
(xaccSplitGetAmount s))))
(unitscoll 'add commodity (xaccSplitGetAmount s))
;; Is the stock transaction?
-;; these lines do nothing, but are in a debug so I'm leaving it, just in case.
asw.
-;; (if (< 0 (gnc-numeric-to-double
-;; (xaccSplitGetAmount s)))
-
-
-;; (set! totalunits
-;; (+ totalunits
-;; (gnc-numeric-to-double
(xaccSplitGetAmount s))))
-;; )
-
-
-;; (set! totalunityears
-;; (+ totalunityears
-;; (* (gnc-numeric-to-double
(xaccSplitGetAmount s))
-;; (gnc:date-year-delta
-;; (car
(gnc-transaction-get-date-posted parent))
-;; (current-time)))))
+ ;; these lines do nothing, but are in a
debug so I'm leaving it, just in case. asw.
+ ;; (if (< 0
(gnc-numeric-to-double
+ ;;
(xaccSplitGetAmount s)))
+
+
+ ;; (set!
totalunits
+ ;; (+
totalunits
+ ;;
(gnc-numeric-to-double (xaccSplitGetAmount s))))
+ ;; )
+
+
+ ;; (set!
totalunityears
+ ;; (+
totalunityears
+ ;; (*
(gnc-numeric-to-double (xaccSplitGetAmount s))
+ ;;
(gnc:date-year-delta
+ ;; (car
(gnc-transaction-get-date-posted parent))
+ ;;
(current-time)))))
(cond
((gnc-numeric-negative-p (xaccSplitGetValue s))
(moneyoutcoll
@@ -425,8 +439,8 @@
)
(xaccAccountGetSplitList current)
)
-;; (gnc:debug "totalunits" totalunits)
-;; (gnc:debug "totalunityears" totalunityears)
+ ;; (gnc:debug "totalunits" totalunits)
+ ;; (gnc:debug "totalunityears" totalunityears)
;; now we determine which price data to use, the pricelist or the
txn
;; and if we have a choice, use whichever is newest.
@@ -444,7 +458,6 @@
(gnc-numeric-abs txn-units)
100
GNC-RND-ROUND))
(gnc:make-gnc-monetary commod-currency
(gnc-numeric-zero))))
-
(set! value (if price (gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul units
(gnc:gnc-monetary-amount price)
@@ -462,11 +475,11 @@
(gaincoll 'merge moneyoutcoll #f)
(gaincoll 'merge moneyincoll #f)
-
-
+ (gnc-price-list-destroy price-list)
(if (or include-empty (not (gnc-numeric-zero-p units)))
- (let* ((moneyin (gnc:monetary-neg
+ (let*
+ ((moneyin (gnc:monetary-neg
(gnc:sum-collector-commodity moneyincoll currency
exchange-fn)))
(moneyout (gnc:sum-collector-commodity moneyoutcoll currency
exchange-fn))
;; just so you know, gain == realized gain, ugain ==
un-realized gain, bothgain, well..
@@ -475,13 +488,11 @@
(gnc-numeric-sub
(gnc:gnc-monetary-amount (exchange-fn value currency))
(sum-basis
basis-list)
100
GNC-RND-ROUND)))
- (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add
(gnc:gnc-monetary-amount gain)
+ (bothgain (gnc:make-gnc-monetary currency
+ (gnc-numeric-add
(gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain)
100 GNC-RND-ROUND)))
-
- (activecols (list (gnc:html-account-anchor current)))
)
-
(total-value 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
(total-moneyin 'merge moneyincoll #f)
(total-moneyout 'merge moneyoutcoll #f)
@@ -489,14 +500,65 @@
(total-ugain 'add (gnc:gnc-monetary-commodity ugain)
(gnc:gnc-monetary-amount ugain))
(total-basis 'add currency (sum-basis basis-list))
- ;; build a list for the row based on user selections
- (if show-symbol (append! activecols (list ticker-symbol)))
- (if show-listing (append! activecols (list listing)))
- (if show-shares (append! activecols (list
(gnc:make-html-table-header-cell/markup
- "number-cell" (xaccPrintAmount units share-print-info)))))
- (if show-price (append! activecols (list
(gnc:make-html-table-header-cell/markup
- "number-cell"
+ ;; build the list with all the computed values
+ (cons (list current
+ ticker-symbol
+ listing
+ units
(if use-txn
+ price
+ (gnc:make-gnc-monetary
+ (gnc-price-get-currency price)
+ (gnc-price-get-value price))) ;; price
(used in sort)
+ (if use-txn "*" " ") ;; use-txn Tick
+ (gnc:make-gnc-monetary currency (sum-basis
basis-list)) ;; basis
+ value
+ moneyin
+ moneyout
+ gain
+ ugain
+ bothgain
+ (let ((moneyinvalue (gnc-numeric-to-double
+
(gnc:gnc-monetary-amount moneyin))))
+ (if (= 0.0 moneyinvalue)
+ moneyinvalue
+ (* 100 (/ (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount
bothgain))
+ moneyinvalue)))) ;; return
+ price
+ use-txn
+ pricing-txn
+ )
+ (table-add-stock-rows-internal rest)))
+ (table-add-stock-rows-internal rest)))
+ ))
+
+ (set! work-to-do (gnc:accounts-count-splits accounts)) ;; #splits as
progress indicator
+
+ (table-add-stock-rows-internal accounts)
+
+ ))
+
+
+ ;; add one row with stock-computed values to the HTML table
+ (define (table-add-stock-row-html table share-print-info odd-row?
+ show-symbol show-listing show-shares
show-price
+ current ticker-symbol listing units
+ rate use-txn-tick basis value money-in
money-out gain ugain bothgain return price use-txn pricing-txn )
+ ;; use-txn-tick price value
money-in money-out gain ugain bothgain return txnprice)
+ (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
+ (odd-row? (not odd-row?))
+ (mycols (list (gnc:html-account-anchor current)))
+ )
+ ;; build the table-row (list) based on user selections
+ (if show-symbol (append! mycols (list ticker-symbol)))
+ (if show-listing (append! mycols (list listing)))
+ (if show-shares (append! mycols
+ (list (gnc:make-html-table-header-cell/markup
+ "number-cell" (xaccPrintAmount units
share-print-info)))))
+ (if show-price (append! mycols
+ (list (gnc:make-html-table-header-cell/markup
+ "number-cell" (if use-txn
(gnc:html-transaction-anchor
pricing-txn
price
@@ -506,43 +568,77 @@
(gnc:make-gnc-monetary
(gnc-price-get-currency price)
(gnc-price-get-value price)))
- )))))
- (append! activecols (list (if use-txn "*" " ")
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:make-gnc-monetary
currency (sum-basis basis-list)))
+ ))))) ;; price
+ (append! mycols (list use-txn-tick
+ (gnc:make-html-table-header-cell/markup
"number-cell" basis)
(gnc:make-html-table-header-cell/markup
"number-cell" value)
- (gnc:make-html-table-header-cell/markup
"number-cell" moneyin)
- (gnc:make-html-table-header-cell/markup
"number-cell" moneyout)
+ (gnc:make-html-table-header-cell/markup
"number-cell" money-in)
+ (gnc:make-html-table-header-cell/markup
"number-cell" money-out)
(gnc:make-html-table-header-cell/markup
"number-cell" gain)
(gnc:make-html-table-header-cell/markup
"number-cell" ugain)
(gnc:make-html-table-header-cell/markup
"number-cell" bothgain)
-
-
- (gnc:make-html-table-header-cell/markup
"number-cell"
- (let ((moneyinvalue
(gnc-numeric-to-double
-
(gnc:gnc-monetary-amount moneyin))))
- (if (= 0.0 moneyinvalue)
- (sprintf #f "%.2f%%"
moneyinvalue)
- (sprintf #f "%.2f%%" (* 100
(/ (gnc-numeric-to-double
-
(gnc:gnc-monetary-amount bothgain))
-
moneyinvalue))))))
- )
- )
-
+ (gnc:make-html-table-header-cell/markup
"number-cell" (sprintf #f "%.2f%%" return))))
(gnc:html-table-append-row/markup!
table
row-style
- activecols)
-
- (table-add-stock-rows-internal rest (not odd-row?))
- )
- (table-add-stock-rows-internal rest odd-row?)
- )
- (gnc-price-list-destroy price-list)
- )))
+ mycols)))
- (set! work-to-do (gnc:accounts-count-splits accounts))
- (table-add-stock-rows-internal accounts #t)))
+ ;; add all computed values off all stocks selected to the HTML table
+ (define (table-add-stock-rows-html table
+ show-symbol show-listing show-shares
show-price
+ account-totals)
+ (let*
+ ;; get printing related options first
+ ((share-print-info (gnc-share-print-info-places
+ (inexact->exact (get-option gnc:pagename-display
+
optname-shares-digits))))
+ (c (get-option gnc:pagename-general
+ optname-sort-column))
+ (odd-row? #t))
+ (for-each
+ (lambda (l)
+ (apply table-add-stock-row-html table share-print-info odd-row?
+ show-symbol show-listing show-shares show-price l))
+ ;; sort column (c in sort-list compare-less procedure) offsets are:
+ ;; 0 account
+ ;; 1 symbol
+ ;; 2 listing
+ ;; 3 shares (units)
+ ;; 4 price (rate)
+ ;; 5 use-txn Tick
+ ;; 6 basis
+ ;; 7 value
+ ;; 8 money-in
+ ;; 9 money-out
+ ;; 10 realized gain
+ ;; 11 unrealized gain
+ ;; 12 total gain
+ ;; 13 total return
+ (sort-list account-totals
+ (cond
+ ((= c 0)
+ (lambda (list1 list2)
+ (if (string<? (xaccAccountGetName (list-ref list1 c))
+ (xaccAccountGetName (list-ref list2
c))) #t #f)))
+ ((or (and (> c 0) (< c 3)) (= c 5))
+ (lambda (list1 list2)
+ (if (string<? (list-ref list1 c) (list-ref list2 c))
#t #f)))
+ ((= c 3)
+ (lambda (list1 list2)
+ (if (< (gnc-numeric-to-double(list-ref list1 c))
+ (gnc-numeric-to-double(list-ref list2 c))) #t
#f)))
+ ((or (= c 4) (= c 6) (= c 7))
+ (lambda (list1 list2)
+ (if (< (if (list-ref list1 c) (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list1 c))) 0.0)
+ (if (list-ref list2 c) (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list2 c))) 0.0)) #t #f)))
+ ((and (> c 6) (< c 13))
+ (lambda (list1 list2)
+ (if (< (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list1 c)))
+ (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list2 c)))) #t #f)))
+ ((> c 12)
+ (lambda (list1 list2)
+ (if (< (list-ref list1 c) (list-ref list2 c)) #t #f)))
+ )))))
;; Tell the user that we're starting.
(gnc:report-starting reportname)
@@ -581,7 +677,7 @@
(total-moneyout (gnc:make-commodity-collector))
(total-gain (gnc:make-commodity-collector)) ;; realized gain
(total-ugain (gnc:make-commodity-collector)) ;; unrealized gain
- ;;document will be the HTML document that we return.
+ ;; document will be the HTML document that we return.
(table (gnc:make-html-table))
(document (gnc:make-html-document)))
@@ -591,7 +687,7 @@
(sprintf #f " %s" (gnc-print-date to-date))))
(if (not (null? accounts))
- ; at least 1 account selected
+ ;; at least 1 account selected
(let* ((exchange-fn (gnc:case-exchange-fn price-source currency
to-date))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(price-fn
@@ -613,7 +709,7 @@
(sum-total-gain (gnc-numeric-zero))
(sum-total-ugain (gnc-numeric-zero)))
- ;;begin building lists for which columns to display
+ ;; begin building lists for which columns to display
(if show-symbol
(begin (append! headercols (list (_ "Symbol")))
(append! totalscols (list " "))))
@@ -646,15 +742,18 @@
table
headercols)
- (table-add-stock-rows
- table accounts to-date currency price-fn exchange-fn
+ (table-add-stock-rows-html table
+ show-symbol show-listing show-shares
show-price
+ (table-add-stock-rows accounts to-date
+ currency price-fn
exchange-fn
include-empty include-gains show-symbol show-listing show-shares
show-price
- basis-method prefer-pricelist total-basis total-value total-moneyin
total-moneyout total-gain total-ugain)
-
+ basis-method
prefer-pricelist
+ total-basis
total-value total-moneyin total-moneyout total-gain total-ugain))
(set! sum-total-gain (gnc:sum-collector-commodity total-gain currency
exchange-fn))
(set! sum-total-ugain (gnc:sum-collector-commodity total-ugain
currency exchange-fn))
- (set! sum-total-both-gains (gnc:make-gnc-monetary currency
(gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain)
+ (set! sum-total-both-gains (gnc:make-gnc-monetary currency
+ (gnc-numeric-add
(gnc:gnc-monetary-amount sum-total-gain)
(gnc:gnc-monetary-amount sum-total-ugain)
100 GNC-RND-ROUND)))
@@ -693,22 +792,21 @@
totalinvalue))))))
))
-
(gnc:html-table-append-row/markup!
table
"grand-total"
- totalscols
- )
+ totalscols)
(gnc:html-document-add-object! document table)
+
(if warn-price-dirty
(gnc:html-document-append-objects! document
(list (gnc:make-html-text (_
"* this commodity data was built using transaction pricing instead of the price
list."))
(gnc:make-html-text
(gnc:html-markup-br))
(gnc:make-html-text (_
"If you are in a multi-currency situation, the exchanges may not be
correct.")))))
-)
+ )
- ;if no accounts selected.
+ ;; if no accounts selected
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
Regards,
Johan
Testresults not solved / explained:
1. with no pricelist data, I expected the transaction price to be
shown, which didn't. Original report behaviour is same. I guess I
don't quite understand the txn pricing.
2. selecting price source "Most recent to report" results in "337:29:
Wrong type to apply: #<unspecified>". Same in original report
(322:25: Wrong type to apply: #<unspecified>)
That's it for now.
-derek
--
Derek Atkins, SB '93 MIT EE, SM '95 MIT Media Laboratory
Member, MIT Student Information Processing Board (SIPB)
URL: http://web.mit.edu/warlord/ PP-ASEL-IA N1NWH
[EMAIL PROTECTED] PGP key available
_______________________________________________
gnucash-devel mailing list
[email protected]
https://lists.gnucash.org/mailman/listinfo/gnucash-devel
