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 "" ""
- ""
- "Description | "
- "Number of Periods | "
- "Amount Budgeted | "
- "Amount Spent | "
- "Delta | "))
- (suffix (list "
" "" ""))
- (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