diff --git a/README b/README index 52288290c8..0e2237d675 100644 --- a/README +++ b/README @@ -245,8 +245,6 @@ fr_CH de_CH - - Other Tools ----------- A tool to generate (ascii) reports from gnucash/xacc files can be found diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm new file mode 100644 index 0000000000..4277ba75d8 --- /dev/null +++ b/src/scm/date-utilities.scm @@ -0,0 +1,82 @@ +;; -*-scheme-*- +;; dateutils.scm +;; date utility functions. mainly used by budget +;; Bryan Larsen (blarsen@ada-works.com) + +(gnc:support "dateutils.scm") + +;; get stuff from localtime date vector +(define (gnc:date-get-year datevec) + (vector-ref datevec 5)) +(define (gnc:date-get-month-day datevec) + (vector-ref datevec 3)) +;; get month with january==1 +(define (gnc:date-get-month datevec) + (+ (vector-ref datevec 4) 1)) +(define (gnc:date-get-week-day datevec) + (vector-ref datevec 6)) +(define (gnc:date-get-year-day datevec) + (vector-ref datevec 7)) + +;; is leap year? +(define (gnc:leap-year? year) + (if (= (remainder year 4) 0) + (if (= (remainder year 100) 0) + (if (= (remainder year 400) 0) #t #f) + #t) + #f)) + +;; number of days in year +(define (gnc:days-in-year year) + (if (gnc:leap-year? year) 366 365)) + +;; number of days in month +(define (gnc:days-in-month month year) + (case month + ((1 3 5 7 8 10 12) 31) + ((4 6 9 11) 30) + ((2) (if (gnc:leap-year? year) 29 28)))) + +;; convert a date in seconds since 1970 into # of years since 1970 as +;; a fraction. +(define (gnc:date-to-year-fraction caltime) + (let ((lt (localtime caltime))) + (+ (- (gnc:date-get-year lt) 1970) + (/ (gnc:date-get-year-day lt) (* 1.0 (gnc:days-in-year + (gnc:date-get-year lt))))))) + +;; convert a date in seconds since 1970 into # of months since 1970 +(define (gnc:date-to-month-fraction caltime) + (let ((lt (localtime caltime))) + (+ (* 12 (- (gnc:date-get-year lt) 1970.0)) + (/ (- (gnc:date-get-month-day lt) 1.0) (gnc:days-in-month + (gnc:date-get-month lt) + (gnc:date-get-year lt)))))) + +;; convert a date in seconds since 1970 into # of weeks since Jan 4, 1970 +;; ignoring leap-seconds +(define (gnc:date-to-week-fraction caltime) + (/ (- (/ (/ caltime 3600.0) 24) 3) 7)) + +;; convert a date in seconds since 1970 into # of days since Jan 1, 1970 +;; ignoring leap-seconds +(define (gnc:date-to-day-fraction caltime) + (/ (/ caltime 3600.0) 24)) + +;; convert a date to a defined fraction +(define (gnc:date-to-N-fraction caltime type) + (case type + ((gnc:budget-day) (gnc:date-to-day-fraction caltime)) + ((gnc:budget-week) (gnc:date-to-week-fraction caltime)) + ((gnc:budget-month) (gnc:date-to-month-fraction caltime)) + ((gnc:budget-year) (gnc:date-to-year-fraction caltime)) + (else (gnc:debug "undefined period type in budget!") #f))) + +;; describe a time type +(define (gnc:date-describe-type type) + (case type + ((gnc:budget-day) "days") + ((gnc:budget-week) "weeks") + ((gnc:budget-month) "months") + ((gnc:budget-year) "years"))) + diff --git a/src/scm/html-generator.scm b/src/scm/html-generator.scm index b0da494020..40826cc690 100644 --- a/src/scm/html-generator.scm +++ b/src/scm/html-generator.scm @@ -3,14 +3,18 @@ (gnc:support "html-generator.scm") -(define (html-table-row header? . items) - (let loop - ((cline "") - (ilist items)) - (if (pair? ilist) - (loop (add-html-cell header? cline (car ilist)) - (cdr ilist)) - (string-append cline "")))) +(define (html-table-row-manual items) + (list + '("") + items + '(""))) + +(define (html-table-row-guess header? strong? items) + (html-table-row-manual + (map + (lambda (item) + (html-cell header? strong? item)) + items))) (define (html-strong cell) (string-append @@ -18,28 +22,79 @@ cell "")) -(define (add-html-cell header? cline item) - (string-append cline (make-html-cell header? item))) +(define (html-currency-cell header? strong? amount) + (html-generic-cell + #t + header? + strong? + (string-append + "(" + (sprintf #f "%.2f" (- amount)) + ")") + (string-append + "> " + (sprintf #f "%.2f" amount) + " ")) + ""))) -(define (make-html-cell header? item) - (let ((pre ;;; Opening tag - (cond - (header? "") - ((number? item) "") - (else ""))) - (post ;;; Closing tag - (if header? "" ""))) - (sprintf #f - (string-append - pre ;;; Start with opening tag - (cond ;;; Body - ((string? item) item) - ((number? item) (sprintf #f "%.2f" item)) - (else "")) - post)))) ;;; closing tag +(define (html-generic-cell right-align? header? strong? item) + (string-append + (if header? "" ">") + (if strong? "" "") + item + (if strong? "" "") + (if header? "" ""))) -(define (make-html-cell-header item) - (make-html-cell #t item)) +(define (html-number-cell header? strong? format number) + (html-generic-cell + #t + header? + strong? + (sprintf #f format number))) + +(define (html-add-cell header? strong? cline item) + (string-append cline (html-cell header? strong? item))) + +;; guess at what type they want +(define (html-cell header? strong? item) + (cond ((string? item) + (html-generic-cell #f header? strong? item)) + ((number? item) + (html-currency-cell header? strong? item)) + (else ""))) + +(define (html-cell-header item) + (html-cell #t #f item)) + +(define (html-cell-body item) + (html-cell #f #f item)) + +(define (html-cell-header-strong item) + (html-cell #t #t item)) + +(define (html-cell-body-strong item) + (html-cell #f #t item)) + +(define (html-cell-header-right item) + (html-generic-cell #t #t #f item)) + +(define (html-start-document) + (list + "" + "")) + +(define (html-end-document) + (list + "" + "")) + +(define (html-start-table) + (list "")) + +(define (html-end-table) + (list "
")) -(define (make-html-cell-body item) - (make-html-cell #f item)) diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index 7b6d850721..588c178b40 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -131,3 +131,70 @@ (if (equal? x (car lst)) lst ; found, quit search and don't add again (cons (car lst) (addunique (cdr lst) x))))) ; keep searching + + +;; find's biggest number in recursive set of vectors +(define (find-largest-in-vector input) + (let loop ((i 0) + (max 0)) ; fixme: should be most negative number + (if (= i (vector-length input)) max + (let subloop ((x (vector-ref input i))) + (cond ((vector? x) (subloop (find-largest-in-vector x))) + ((number? x) (if (> x max) (loop (+ i 1) x) (loop (+ i 1) max))) + (else (loop (+ i 1) max))))))) + + +;; takes in a vector consisting of integers, #f's and vectors (which +;; take integers, #f's and vectors ...) +;; the output vector will contain references to integer N in position N. +;; +;; example: +;; #(1 #(0 #f 2) 3) -> #( (1 0) (0) (1 2) (2) ) + +(define (find-vector-mappings input) + (let ((outvec (make-vector (+ 1 (find-largest-in-vector input)) #f))) + (let loop ((i 0) + (refs '()) + (vec input)) + (cond ((= i (vector-length vec)) outvec) + (else + (let ((item (vector-ref vec i))) + (if (vector? item) (loop 0 (cons i refs) item)) + (if (integer? item) + (if (>= item 0) + (vector-set! outvec item (reverse (cons i refs))))) + (loop (+ i 1) refs vec))))) + outvec)) + +;; recursively apply vector-ref +(define (vector-N-ref vector ref-list) + (cond ((eqv? ref-list '()) vector) + (else (vector-N-ref (vector-ref vector (car ref-list)) (cdr ref-list))))) + +;; map's a recursive vector in a given order (returning a list). the +;; order is as generated by find-vector-mappings. +(define (vector-map-in-specified-order proc vector order) + (let loop ((i 0)) + (cond ((= i (vector-length order)) '()) + (else + (let ((ref-list (vector-ref order i))) + (cond ((not ref-list) (loop (+ 1 i))) + (else + (cons (proc (vector-N-ref vector ref-list)) + (loop (+ 1 i)))))))))) + +;; map's a recursive vector in a given order (returning a list). the +;; order is as generated by find-vector-mappings. the procedure is a +;; vector itself, with the same structure as the input vector. +(define (vector-map-in-specified-order-uniquely procvec vector order) + (let loop ((i 0)) + (cond ((= i (vector-length order)) '()) + (else + (let ((ref-list (vector-ref order i))) + (cond ((not ref-list) (loop (+ 1 i))) + (else + (cons ((vector-N-ref procvec ref-list) + (vector-N-ref vector ref-list)) + (loop (+ 1 i)))))))))) + + diff --git a/src/scm/report/budget-report.scm b/src/scm/report/budget-report.scm index e9433ad755..d651f0f051 100644 --- a/src/scm/report/budget-report.scm +++ b/src/scm/report/budget-report.scm @@ -1,25 +1,33 @@ ;; -*-scheme-*- ;; budget-report.scm ;; Report on budget -;; uses some functions from transaction-report ;; Bryan Larsen (blarsen@ada-works.com) ;; situations I want to handle -;; lunch M-F +;; lunch M-F -- funny period ;; xmas gifts & birthday gifts in same budget line -;; car repairs -;; car fuel-ups -;; paychecks & rent payments +;; car repairs -- contingency +;; car fuel-ups -- known amount, variable period +;; paychecks & rent payments -- specific dates (require 'sort) -;(require 'time) (gnc:depend "report-utilities.scm") +(gnc:depend "html-generator.scm") +(gnc:depend "date-utilities.scm") + ;; time values -(define gnc:budget-day 1) -(define gnc:budget-week 2) -(define gnc:budget-month 3) -(define gnc:budget-year 4) +;(define gnc:budget-day 1) +;(define gnc:budget-week 2) +;(define gnc:budget-month 3) +;(define gnc:budget-year 4) + +;; budget types +(define gnc:budget-recurring 1) ; regular, recurring budget expenses + ; that happen once per period +(define gnc:budget-contingency 2) ; a budget item where you estimate a + ; value over a long period for + ; unexpected expenses. ;; define the budget itself. For prototype, define inline. ;; the budget is a vector of vectors. the vectors contain: @@ -31,8 +39,32 @@ ;; 4 - period-type: ;; 5 - triggers: as yet undefined (define gnc:budget - #(#("lunch" 8 ("Food:Lunch") 1 gnc:budget-day) - #("junk food" 0.50 ("Food:Junk") 1 gnc:budget-day))) + #(#("lunch" 8 ("Food:Lunch") 1 gnc:budget-day gnc:budget-recurring) + #("junk food" 0.50 ("Food:Junk") 1 gnc:budget-day gnc:budget-recurring) + #("car repairs" 2500 ("Car:Repairs") 5 gnc:budget-year gnc:budget-contingency))) + +(define gnc:budget-headers + #(("" "Description") + ("Amount" "per Period") + ("" "Accounts") + ("Period" "Size") + ("Period" "Size Units") + ("Budget" "Type"))) + +(define (gnc:budget-html-cell-pred) + (vector + (lambda (item) + (html-generic-cell #f #f #f item)) + (lambda (item) + (html-currency-cell #f #f item)) + (lambda (item) + '()) ; todo: accounts + (lambda (item) + (html-number-cell #f #f "%i" item)) + (lambda (item) + (html-generic-cell #f #f #f (gnc:date-describe-type item))) + (lambda (item) + '()))) ; todo: budget-type (define (gnc:budget-get-description budget-line) (vector-ref budget-line 0)) @@ -51,213 +83,179 @@ ;; budget report: a vector with indexes corresponding to the budget ;; 0 - actual: the amount spend / recieved -;; 1 - desired: the budgeted amount +;; 1 - budgeted: the budgeted amount. Simply the periods * amount ;; 2 - periods: the number of periods for the line in the report +;; 3 - mimimum-expected: minimum you expected to spend during the +;; report period +;; 4 - maximum-expected: the maximum you can spend in the report period +;; 5 - time remaining: how much of a period is remaining until the end +;; of the budget period + +(define gnc:budget-report-headers + #(("Amount" "Spent") + ("Amount" "Budgeted") + ("Number of" "Periods") + ("Lower" "Limit") + ("Upper" "Limit") + ("Time" "Remaining"))) + +(define (gnc:budget-report-html-cell-pred) + (vector + (lambda (item) + (html-currency-cell #f #f item)) + (lambda (item) + (html-currency-cell #f #f item)) + (lambda (item) + (html-number-cell #f #f "%.1f" item)) + (lambda (item) + (html-currency-cell #f #f item)) + (lambda (item) + (html-currency-cell #f #f item)) + (lambda (item) + (html-number-cell #f #f "%.1f" item)))) (define (gnc:budget-report-get-actual brep-line) (vector-ref brep-line 0)) -(define (gnc:budget-report-get-desired brep-line) +(define (gnc:budget-report-get-budgeted brep-line) (vector-ref brep-line 1)) (define (gnc:budget-report-get-periods brep-line) (vector-ref brep-line 2)) -;; accumulate the actual amounts for the budget given a split and -;; a budget. returns the budget-report vector. The split is a 2 item list: -;; account name and value -;; obsolete -(define (gnc:budget-report-accumulate-actual sub-split budget budget-report) - (do ((i 0 (+ i 1))) - ((= i (vector-length budget)) budget-report) - (let ((budget-line (vector-ref budget i)) - (budget-report-line (vector-ref budget-report i)) - (name (car sub-split)) - (value (cadr sub-split))) - (for-each - (lambda (budget-account-name) - (if (string-ci=? name budget-account-name) - (begin - (vector-set! budget-report-line 0 - (+ (gnc:budget-report-get-actual - budget-report-line) - value))))) - (gnc:budget-get-accounts budget-line))))) +(define (gnc:budget-report-get-minimum-expected brep-line) + (vector-ref brep-line 3)) + +(define (gnc:budget-report-get-maximum-expected brep-line) + (vector-ref brep-line 4)) + +(define (gnc:budget-report-get-time-remaining brep-line) + (vector-ref brep-line 5)) ;; add a value to the budget accumulator -(define (gnc:budget-accumulate-actual value budget-report-line) +(define (gnc:budget-accumulate-actual! value budget-report-line) (vector-set! budget-report-line 0 (+ (gnc:budget-report-get-actual budget-report-line) - value)) - budget-report-line) + value))) - -;; convert budget-report to an html table -(define (gnc:budget-report-to-html budget budget-report) - (let ((budget-html ())) - (do ((i 0 (+ i 1))) - ((= i (vector-length budget)) budget-html) - (let ((budget-line (vector-ref budget i)) - (budget-report-line (vector-ref budget-report i))) - (set! budget-html - (append - budget-html - (list - (string-append - "" - (gnc:budget-get-description budget-line) - "" - (sprintf - #f "%.1f" - (gnc:budget-report-get-periods budget-report-line)) - "" - (sprintf - #f "%.2f" (gnc:budget-report-get-desired - budget-report-line)) - "" - (sprintf - #f "%.2f" (gnc:budget-report-get-actual - budget-report-line)) - "" - (sprintf - #f "%.2f" (- (gnc:budget-report-get-desired - budget-report-line) - (gnc:budget-report-get-actual - budget-report-line))) - "")))))))) - -;; given an account name, return the budget line number -;; return #f if there is no budget line for that account -(define (gnc:budget-get-line-number account-name budget) - (let loop ((i 0)) -; (gnc:debug i) -; (gnc:debug (car (gnc:budget-get-accounts (vector-ref budget i)))) - (cond ((= i (vector-length budget)) #f) - ((let loop2 - ((accounts (gnc:budget-get-accounts (vector-ref budget i)))) - (cond ((null? accounts) #f) - (else (or (string=? account-name (car accounts)) - (loop2 (cdr accounts)))))) i) -; ((string=? account-name (car (gnc:budget-get-accounts (vector-ref budget i)))) i) - (else (loop (+ i 1)))))) - - -;; get stuff from localtime date vector -(define (gnc:date-get-year datevec) - (vector-ref datevec 5)) -(define (gnc:date-get-month-day datevec) - (vector-ref datevec 3)) -;; get month with january==1 -(define (gnc:date-get-month datevec) - (+ (vector-ref datevec 4) 1)) -(define (gnc:date-get-week-day datevec) - (vector-ref datevec 6)) -(define (gnc:date-get-year-day datevec) - (vector-ref datevec 7)) - -;; is leap year? -(define (gnc:leap-year? year) - (if (= (remainder year 4) 0) - (if (= (remainder year 100) 0) - (if (= (remainder year 400) 0) #t #f) - #t) - #f)) - -;; number of days in year -(define (gnc:days-in-year year) - (if (gnc:leap-year? year) 366 365)) - -;; number of days in month -(define (gnc:days-in-month month year) - (case month - ((1 3 5 7 8 10 12) 31) - ((4 6 9 11) 30) - ((2) (if (gnc:leap-year? year) 29 28)))) - -;; convert a date in seconds since 1970 into # of years since 1970 as -;; a fraction. -(define (gnc:date-to-year-fraction caltime) - (let ((lt (localtime caltime))) - (+ (- (gnc:date-get-year lt) 1970) - (/ (gnc:date-get-year-day lt) (* 1.0 (gnc:days-in-year - (gnc:date-get-year lt))))))) - -;; convert a date in seconds since 1970 into # of months since 1970 -(define (gnc:date-to-month-fraction caltime) - (let ((lt (localtime caltime))) - (+ (* 12 (- (gnc:date-get-year lt) 1970.0)) - (/ (- (gnc:date-get-month-day lt) 1.0) (gnc:days-in-month - (gnc:date-get-month lt)))))) - -;; convert a date in seconds since 1970 into # of weeks since Jan 4, 1970 -;; ignoring leap-seconds -(define (gnc:date-to-week-fraction caltime) - (/ (- (/ (/ caltime 3600.0) 24) 3) 7)) - -;; convert a date in seconds since 1970 into # of days since Jan 1, 1970 -;; ignoring leap-seconds -(define (gnc:date-to-day-fraction caltime) - (/ (/ caltime 3600.0) 24)) - -;; convert a date to a defined fraction -(define (gnc:date-to-N-fraction caltime type) - (case type - ((gnc:budget-day) (gnc:date-to-day-fraction caltime)) - ((gnc:budget-week) (gnc:date-to-week-fraction caltime)) - ((gnc:budget-month) (gnc:date-to-month-fraction caltime)) - ((gnc:budget-year) (gnc:date-to-year-fraction caltime)) - (else (gnc:debug "undefined period type in budget!") #f))) - -;; calculate the # of periods on a budget line. return the budget report line +;; calculate the # of periods on a budget line. ;; dates are in # seconds after 1970 -(define (gnc:budget-calculate-periods budget-line budget-report-line +(define (gnc:budget-calculate-periods! budget-line budget-report-line begin-date end-date) (let* ((N-type (gnc:budget-get-period-type budget-line)) (begin-N (gnc:date-to-N-fraction begin-date N-type)) (end-N (gnc:date-to-N-fraction end-date N-type))) (vector-set! budget-report-line 2 (/ (- end-N begin-N) - (gnc:budget-get-period budget-line))) - budget-report-line)) + (gnc:budget-get-period budget-line))))) -;; return what you are passed -(define (null-filter) - (lambda(x) x)) +;; calculate the budgeted value. +;; dependency: budget-calculate-periods! +(define (gnc:budget-calculate-budgeted! budget-line budget-report-line) + (vector-set! budget-report-line 1 + (* (gnc:budget-get-amount budget-line) + (gnc:budget-report-get-periods budget-report-line)))) -;; calculate the expected budget value. return the budget report line -(define (gnc:budget-calculate-expected budget-line budget-report-line - begin-date end-date) +;; calculate the values for minimum-expected and maxmimum-expected +;; dependency: budget-calculate-periods! +(define (gnc:budget-calculate-expected! budget-line budget-report-line) (begin - (vector-set! budget-report-line 1 - (* (gnc:budget-get-amount budget-line) - (gnc:budget-report-get-periods budget-report-line))) - budget-report-line)) + (vector-set! + budget-report-line 3 + (* (gnc:budget-get-amount budget-line) + (floor (gnc:budget-report-get-periods budget-report-line)))) + (vector-set! + budget-report-line 4 + (* (gnc:budget-get-amount budget-line) + (ceiling (gnc:budget-report-get-periods budget-report-line)))))) + +;; calculate the amount of time remaining in the budget period +;; dependency: budget-calculate-periods! +(define (gnc:budget-calculate-time-remaining! budget-line budget-report-line) + (vector-set! + budget-report-line 5 + (* (- (ceiling (gnc:budget-report-get-periods budget-report-line)) + (gnc:budget-report-get-periods budget-report-line)) + (gnc:budget-get-period budget-line)))) + +;; given an account name, return the budget line number +;; return #f if there is no budget line for that account +(define (gnc:budget-get-line-number account-name budget) + (let loop ((i 0)) + (cond ((= i (vector-length budget)) #f) + ((let loop2 + ((accounts (gnc:budget-get-accounts (vector-ref budget i)))) + (cond ((null? accounts) #f) + (else (or (string=? account-name (car accounts)) + (loop2 (cdr accounts)))))) i) + (else (loop (+ i 1)))))) + + +;; register a configuration option for the budget report +(define (budget-report-options-generator) + + (define gnc:*budget-report-options* (gnc:new-options)) + + (define (gnc:register-budget-report-option new-option) + (gnc:register-option gnc:*budget-report-options* new-option)) + + ;; from date + ;; hack alert - could somebody set this to an appropriate date? + (gnc:register-budget-report-option + (gnc:make-date-option + "Report Options" "From" + "a" "Report start date" + (lambda () + (let ((bdtime (localtime (current-time)))) + (set-tm:sec bdtime 0) + (set-tm:min bdtime 0) + (set-tm:hour bdtime 0) + (set-tm:mday bdtime 1) + (set-tm:mon bdtime 0) + (let ((time (car (mktime bdtime)))) + (cons time 0)))) + #f)) + + ;; to-date + (gnc:register-budget-report-option + (gnc:make-date-option + "Report Options" "To" + "b" "Report end date" + (lambda () (cons (current-time) 0)) + #f)) + + ;; view + (gnc:register-budget-report-option + (gnc:make-multichoice-option + "Report Options" "View" + "c" "Type of budget report" + 'status + (list #(full + "Full" + "Show all columns") + #(balancing + "Balancing" + "A report useful for balancing the budget") + #(status + "Status" + "How are you doing on your budget?")))) + gnc:*budget-report-options*) + + + (gnc:define-report ;; version 1 ;; Name "Budget" ;; Options - trep-options-generator + budget-report-options-generator ;; renderer (lambda (options) (let* ((begindate (gnc:lookup-option options "Report Options" "From")) (enddate (gnc:lookup-option options "Report Options" "To")) - (tr-report-account-op (gnc:lookup-option options - "Report Options" "Account")) - (prefix (list "" "" - "" - "" - "" - "" - "" - "")) - (suffix (list "
DescriptionNumber of PeriodsAmount BudgetedAmount SpentDelta
" "" "")) - (input-transactions '()) - (budget-report #()) - (budget-html "") (date-filter-pred (gnc:tr-report-make-filter-predicate (gnc:option-value begindate) (gnc:option-value enddate))) @@ -265,54 +263,87 @@ (gnc:option-value begindate)))) (end-date-secs (car (gnc:timepair-canonical-day-time (gnc:option-value enddate)))) - (accounts (gnc:option-value tr-report-account-op))) - (set! budget-report (make-vector - (vector-length gnc:budget))) + (budget-report (make-vector (vector-length gnc:budget))) + (budget-order #()) + (budget-report-order #())) + (gnc:debug gnc:budget) + (do ((i 0 (+ i 1))) ((= i (vector-length gnc:budget))) - (vector-set! budget-report i (vector 0 0 0))) + (vector-set! budget-report i (vector 0 0 0 0 0 0))) + (let loop ((group (gnc:get-current-group))) (if (not (pointer-token-null? group)) (gnc:group-map-accounts (lambda (account) - (let* ((name (gnc:account-get-full-name account)) - (line (gnc:budget-get-line-number name gnc:budget)) - (children (gnc:account-get-children account))) + (let ((line + (gnc:budget-get-line-number + (gnc:account-get-full-name account) + gnc:budget)) + (children (gnc:account-get-children account))) (if line (gnc:for-each-split-in-account account (lambda (split) - (vector-set! - budget-report line - (gnc:budget-accumulate-actual + (gnc:budget-accumulate-actual! (gnc:split-get-value split) - (vector-ref budget-report line)))))) - (if (not (pointer-token-null? children)) (loop children)))) + (vector-ref budget-report line))))) + (loop children))) group))) - (gnc:debug budget-report) - (gnc:debug begin-date-secs) - (gnc:debug end-date-secs) - (gnc:debug (gnc:timepair-canonical-day-time - (gnc:option-value begindate))) - (gnc:debug (gnc:timepair-canonical-day-time - (gnc:option-value enddate))) (do ((i 0 (+ i 1))) ((= i (vector-length gnc:budget))) - (vector-set! budget-report i - (gnc:budget-calculate-expected - (vector-ref gnc:budget i) - (gnc:budget-calculate-periods - (vector-ref gnc:budget i) - (vector-ref budget-report i) - begin-date-secs - end-date-secs) - begin-date-secs - end-date-secs))) + (let ((budget-line (vector-ref gnc:budget i)) + (budget-report-line (vector-ref budget-report i))) + (gnc:budget-calculate-periods! + budget-line budget-report-line begin-date-secs end-date-secs) + (gnc:budget-calculate-budgeted! budget-line budget-report-line) + (gnc:budget-calculate-expected! budget-line budget-report-line) + (gnc:budget-calculate-time-remaining! budget-line budget-report-line))) (gnc:debug budget-report) - - (set! budget-html (gnc:budget-report-to-html - gnc:budget budget-report)) - - (append prefix budget-html suffix)))) + + (case (gnc:option-value + (gnc:lookup-option options "Report Options" "View")) + ((full) + (set! budget-order (vector 1 2 #f 3 4 #f)) + (set! budget-report-order (vector 5 6 7 8 9 10))) + ((balancing) + (set! budget-order #(1 2 #f 3 4 #f)) + (set! budget-report-order #(#f 6 5 #f #f #f))) + ((status) + (set! budget-order #(1 #f #f #f 3 #f)) + (set! budget-report-order #(10 #f #f 4 5 2))) + (else + (gnc:debug "Invalid view option"))) + + (let ((order (find-vector-mappings + (vector budget-order budget-report-order)))) + (list + (html-start-document) + "

This is a budget report. It is very preliminary, but you may find it useful. To actually change the budget, currently you have to edit budget-report.scm.

" + (html-start-table) + (html-table-row-manual + (vector-map-in-specified-order + (lambda (item) (html-cell-header (car item))) + (vector gnc:budget-headers gnc:budget-report-headers) + order)) + (html-table-row-manual + (vector-map-in-specified-order + (lambda (item) (html-cell-header (cadr item))) + (vector gnc:budget-headers gnc:budget-report-headers) + order)) + (let loop ((row 0)) + (cond ((= row (vector-length gnc:budget)) '()) + (else + (cons + (html-table-row-manual + (vector-map-in-specified-order-uniquely + (vector (gnc:budget-html-cell-pred) + (gnc:budget-report-html-cell-pred)) + (vector (vector-ref gnc:budget row) + (vector-ref budget-report row)) + order)) + (loop (+ row 1)))))) + (html-end-table) + (html-end-document)))))) \ No newline at end of file