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 c 0) (< c 3)) (= c 5)) + (lambda (list1 list2) + (if (string 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