mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Mark options strings as translatable using N_.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3334 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
@@ -30,8 +30,8 @@
|
||||
;; to-date
|
||||
(gnc:register-accsum-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "To"
|
||||
"a" "Report up to and including this date"
|
||||
(N_ "Report Options") (N_ "To")
|
||||
"a" (N_ "Report up to and including this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 59)
|
||||
@@ -43,8 +43,8 @@
|
||||
;; account(s) to do report on
|
||||
(gnc:register-accsum-option
|
||||
(gnc:make-account-list-option
|
||||
"Report Options" "Account"
|
||||
"b" "Report on these account(s)"
|
||||
(N_ "Report Options") (N_ "Account")
|
||||
"b" (N_ "Report on these account(s)")
|
||||
(lambda ()
|
||||
(let ((current-accounts (gnc:get-current-accounts)))
|
||||
(cond ((not (null? current-accounts)) current-accounts)
|
||||
@@ -54,8 +54,8 @@
|
||||
|
||||
(gnc:register-accsum-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Report Options" "Sub-Accounts"
|
||||
"c" "Include Sub-Accounts of each selected Account" #f))
|
||||
(N_ "Report Options") (N_ "Sub-Accounts")
|
||||
"c" (N_ "Include Sub-Accounts of each selected Account") #f))
|
||||
|
||||
gnc:*accsum-track-options*))
|
||||
|
||||
|
||||
@@ -49,8 +49,8 @@
|
||||
;; from date
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "From"
|
||||
"a" "Report Items from this date"
|
||||
(N_ "Report Options") (N_ "From")
|
||||
"a" (N_ "Report Items from this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 0)
|
||||
@@ -65,8 +65,8 @@
|
||||
;; to-date
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "To"
|
||||
"c" "Report items up to and including this date"
|
||||
(N_ "Report Options") (N_ "To")
|
||||
"c" (N_ "Report items up to and including this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 59)
|
||||
@@ -79,8 +79,8 @@
|
||||
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-account-list-option
|
||||
"Report Options" "Account"
|
||||
"d" "Do transaction report on this account"
|
||||
(N_ "Report Options") (N_ "Account")
|
||||
"d" (N_ "Do transaction report on this account")
|
||||
(lambda ()
|
||||
(let ((current-accounts (gnc:get-current-accounts)))
|
||||
(cond ((not (null? current-accounts)) current-accounts)
|
||||
@@ -90,8 +90,8 @@
|
||||
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-multichoice-option
|
||||
"Report Options" "Step Size"
|
||||
"b" "The amount of time between data points" 'WeekDelta
|
||||
(N_ "Report Options") (N_ "Step Size")
|
||||
"b" (N_ "The amount of time between data points") 'WeekDelta
|
||||
(list #(DayDelta "Day" "Day")
|
||||
#(WeekDelta "Week" "Week")
|
||||
#(TwoWeekDelta "2Week" "Two Week")
|
||||
@@ -101,17 +101,22 @@
|
||||
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Report Options" "Sub-Accounts"
|
||||
"e" "Include sub-accounts of all selected accounts" #f))
|
||||
(N_ "Report Options") (N_ "Sub-Accounts")
|
||||
"e" (N_ "Include sub-accounts of all selected accounts") #f))
|
||||
|
||||
(gnc:register-runavg-option
|
||||
(gnc:make-multichoice-option
|
||||
"Report Options" "Plot Type"
|
||||
"f" "The type of graph to generate" 'NoPlot
|
||||
(list #(NoPlot "Nothing" "Make No Plot")
|
||||
#(AvgBalPlot "Average" "Average Balance")
|
||||
#(GainPlot "Net Gain" "Net Gain")
|
||||
#(GLPlot "Gain/Loss" "Gain And Loss"))))
|
||||
(N_ "Report Options") (N_ "Plot Type")
|
||||
"f" (N_ "The type of graph to generate") 'NoPlot
|
||||
(list (list->vector
|
||||
(list 'NoPlot (N_ "Nothing") (N_ "Make No Plot")))
|
||||
(list->vector
|
||||
(list 'AvgBalPlot (N_ "Average") (N_ "Average Balance")))
|
||||
(list->vector
|
||||
(list 'GainPlot (N_ "Net Gain") (N_ "Net Gain")))
|
||||
(list->vector
|
||||
(list 'GLPlot (N_ "Gain/Loss") (N_ "Gain And Loss"))))))
|
||||
|
||||
gnc:*runavg-track-options*))
|
||||
|
||||
;; Text table
|
||||
@@ -311,11 +316,9 @@
|
||||
'())
|
||||
(allsubaccounts (cdr accounts))))))
|
||||
|
||||
(define string-db (gnc:make-string-database))
|
||||
|
||||
(define (column-list)
|
||||
(map (lambda (key) (string-db 'lookup key))
|
||||
(list 'beginning 'ending 'average 'max 'min 'net-gain 'gain 'loss)))
|
||||
(list (_ "Beginning") (_ "Ending") (_ "Average") (_ "Max") (_ "Min")
|
||||
(_ "Net Gain") (_ "Gain") (_ "Loss")))
|
||||
|
||||
(define (average-balance-renderer options)
|
||||
(let ((gov-fun (lambda (value)
|
||||
@@ -343,12 +346,12 @@
|
||||
(cond ((null? accounts)
|
||||
(set! rept-text
|
||||
(list "<TR><TD>"
|
||||
(string-db 'lookup 'no-account)
|
||||
(_ "You have not selected an account.")
|
||||
"</TD></TR>")))
|
||||
((gnc:timepair-le enddate begindate)
|
||||
(set! rept-text
|
||||
(list "<TR><TD><EM>"
|
||||
(string-db 'lookup 'dates-reversed)
|
||||
(_ "Please choose appropriate dates - the \"To\" date should be *after* the \"From\" date.")
|
||||
"</EM></TD></TR>")))
|
||||
(else (begin
|
||||
|
||||
@@ -403,7 +406,7 @@
|
||||
"set title '" acctname "'\n"
|
||||
"set ylabel '" acctcurrency "'\n"
|
||||
"set xlabel '"
|
||||
(string-db 'lookup 'period-ending)
|
||||
(_ "Period Ending")
|
||||
"'\n")))
|
||||
|
||||
(data-to-gpfile columns (gnuplot-reduced-list rept-data)
|
||||
@@ -413,33 +416,19 @@
|
||||
fn "'" plotstr
|
||||
"\"|gnuplot -persist " )))))))
|
||||
|
||||
(append prefix
|
||||
(if (null? accounts)
|
||||
'()
|
||||
(list (sprintf #f
|
||||
(string-db 'lookup
|
||||
(if dosubs
|
||||
'report-for-and
|
||||
'report-for))
|
||||
acctname)
|
||||
"<p>\n"))
|
||||
(list rept-text)
|
||||
suffix))))
|
||||
|
||||
;; Define the strings
|
||||
(string-db 'store 'beginning "Beginning")
|
||||
(string-db 'store 'ending "Ending")
|
||||
(string-db 'store 'average "Average")
|
||||
(string-db 'store 'max "Max")
|
||||
(string-db 'store 'min "Min")
|
||||
(string-db 'store 'net-gain "Net Gain")
|
||||
(string-db 'store 'gain "Gain")
|
||||
(string-db 'store 'loss "Loss")
|
||||
(string-db 'store 'no-account "You have not selected an account.")
|
||||
(string-db 'store 'dates-reversed "Please choose appropriate dates - the \"To\" date should be *after* the \"From\" date.")
|
||||
(string-db 'store 'period-ending "Period Ending")
|
||||
(string-db 'store 'report-for "Report for %s.")
|
||||
(string-db 'store 'report-for-and "Report for %s and all subaccounts.")
|
||||
(append
|
||||
prefix
|
||||
(if (null? accounts)
|
||||
'()
|
||||
(list
|
||||
(sprintf #f
|
||||
(if dosubs
|
||||
(_ "Report for %s and all subaccounts.")
|
||||
(_ "Report for %s."))
|
||||
acctname)
|
||||
"<p>\n"))
|
||||
(list rept-text)
|
||||
suffix))))
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
|
||||
@@ -35,22 +35,21 @@
|
||||
(l2-collector (make-currency-collector))
|
||||
(default-exchange-rate 0) ;; if there is no user-specified exchange rate
|
||||
(currency-pref-options
|
||||
'(("Currency 1" "USD")
|
||||
("Currency 2" "EUR")
|
||||
("Currency 3" "DEM")
|
||||
("Currency 4" "GBP")
|
||||
("Currency 5" "FRF")))
|
||||
(currency-option-value-prefix "Exchange rate for ")
|
||||
(list
|
||||
(list (N_ "Currency 1") "USD")
|
||||
(list (N_ "Currency 2") "EUR")
|
||||
(list (N_ "Currency 3") "DEM")
|
||||
(list (N_ "Currency 4") "GBP")
|
||||
(list (N_ "Currency 5") "FRF")))
|
||||
(currency-option-value-prefix (N_ "Exchange rate for "))
|
||||
(EMPTY_ROW "<tr></tr>"))
|
||||
|
||||
(define string-db (gnc:make-string-database))
|
||||
|
||||
(define (register-common-options option-registerer)
|
||||
(begin
|
||||
(option-registerer
|
||||
(gnc:make-date-option
|
||||
"Report" "To"
|
||||
"b" "Calculate balance sheet up to this date"
|
||||
(N_ "Report") (N_ "To")
|
||||
"b" (N_ "Calculate balance sheet up to this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 59)
|
||||
@@ -86,8 +85,8 @@
|
||||
|
||||
(option-registerer
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Type"
|
||||
"b" "Display the account type?" #f))
|
||||
(N_ "Display") (N_ "Type")
|
||||
"b" (N_ "Display the account type?") #f))
|
||||
|
||||
; (option-registerer
|
||||
; (gnc:make-simple-boolean-option
|
||||
@@ -96,33 +95,33 @@
|
||||
|
||||
(option-registerer
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Foreign Currency"
|
||||
"b" "Display the account's foreign currency amount?" #t))
|
||||
(N_ "Display") (N_ "Foreign Currency")
|
||||
"b" (N_ "Display the account's foreign currency amount?") #t))
|
||||
|
||||
(option-registerer
|
||||
(gnc:make-currency-option
|
||||
"Currencies" "Report's currency"
|
||||
"AA" "All other currencies will get converted to this currency."
|
||||
(N_ "Currencies") (N_ "Report's currency")
|
||||
"AA" (N_ "All other currencies will get converted to this currency.")
|
||||
(gnc:locale-default-currency)))
|
||||
|
||||
(option-registerer
|
||||
(gnc:make-simple-boolean-option
|
||||
"Currencies" "Other currencies' total"
|
||||
"AB" "Show the total amount of other currencies?" #f))
|
||||
|
||||
(N_ "Currencies") (N_ "Other currencies' total")
|
||||
"AB" (N_ "Show the total amount of other currencies?") #f))
|
||||
|
||||
(for-each
|
||||
(lambda(x)(begin (option-registerer
|
||||
(gnc:make-currency-option
|
||||
"Currencies" (car x)
|
||||
(N_ "Currencies") (car x)
|
||||
(string-append (car x) "a")
|
||||
"Choose foreign currency to specify an exchange rate for"
|
||||
(N_ "Choose foreign currency to specify an exchange rate for")
|
||||
(cadr x)))
|
||||
(option-registerer
|
||||
(gnc:make-string-option
|
||||
"Currencies"
|
||||
(N_ "Currencies")
|
||||
(string-append currency-option-value-prefix (car x))
|
||||
(string-append (car x) "b")
|
||||
"Choose exchange rate for above currency"
|
||||
(N_ "Choose exchange rate for above currency")
|
||||
(number->string default-exchange-rate)))))
|
||||
currency-pref-options)))
|
||||
|
||||
@@ -146,8 +145,8 @@
|
||||
|
||||
(gnc:register-pnl-option
|
||||
(gnc:make-date-option
|
||||
"Report" "From"
|
||||
"a" "Start of reporting period"
|
||||
(N_ "Report") (N_ "From")
|
||||
"a" (N_ "Start of reporting period")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 0)
|
||||
@@ -245,7 +244,7 @@
|
||||
balance-currency exchange-alist
|
||||
other-currency-total? show-fcur?
|
||||
row-aligner)
|
||||
(let ((account-name (string-html-strong (string-db 'lookup 'net)))
|
||||
(let ((account-name (string-html-strong (_ "Net")))
|
||||
(exchanged-total 0))
|
||||
(list
|
||||
EMPTY_ROW
|
||||
@@ -503,15 +502,15 @@
|
||||
|
||||
"<table cellpadding=0>"
|
||||
"<tr>"
|
||||
"<th>" (string-db 'lookup 'account-name) "</th>"
|
||||
(if show-type? (string-append "<th align=center>"
|
||||
(string-db 'lookup 'type) "</th>")
|
||||
"<th>" (_ "Account Name") "</th>"
|
||||
(if show-type?
|
||||
(string-append "<th align=center>" (_ "Type") "</th>")
|
||||
"")
|
||||
"<th "
|
||||
(if show-fcur? "colspan=2 " "")
|
||||
"align=right>" (string-db 'lookup 'subaccounts) "</th>"
|
||||
"align=right>" (_ "(subaccounts)") "</th>"
|
||||
(if show-fcur? "<th></th>" "")
|
||||
"<th align=right>" (string-db 'lookup 'balance) "</th>"
|
||||
"<th align=right>" (_ "Balance") "</th>"
|
||||
"</tr>"
|
||||
|
||||
output
|
||||
@@ -520,24 +519,14 @@
|
||||
"</body>"
|
||||
"</html>"))))
|
||||
|
||||
(string-db 'store 'net "Net")
|
||||
(string-db 'store 'type "Type")
|
||||
(string-db 'store 'account-name "Account Name")
|
||||
(string-db 'store 'subaccounts "(subaccounts)")
|
||||
(string-db 'store 'balance "Balance")
|
||||
(string-db 'store 'bal-title "Balance Sheet")
|
||||
(string-db 'store 'bal-desc "This page shows your net worth.")
|
||||
(string-db 'store 'pnl-title "Profit and Loss")
|
||||
(string-db 'store 'pnl-desc "This page shows your profits and losses.")
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name "Balance sheet"
|
||||
'options-generator balsht-options-generator
|
||||
'renderer (lambda (options)
|
||||
(generate-balance-sheet-or-pnl
|
||||
(string-db 'lookup 'bal-title)
|
||||
(string-db 'lookup 'bal-desc)
|
||||
(_ "Balance Sheet")
|
||||
(_ "This page shows your net worth.")
|
||||
options
|
||||
#t)))
|
||||
|
||||
@@ -546,8 +535,8 @@
|
||||
'name "Profit and Loss"
|
||||
'options-generator pnl-options-generator
|
||||
'renderer (lambda (options)
|
||||
(generate-balance-sheet-or-pnl
|
||||
(string-db 'lookup 'pnl-title)
|
||||
(string-db 'lookup 'pnl-desc)
|
||||
(generate-balance-sheet-or-pnl
|
||||
(_ "Profit and Loss")
|
||||
(_"This page shows your profits and losses.")
|
||||
options
|
||||
#f))))
|
||||
|
||||
@@ -793,8 +793,8 @@
|
||||
;; 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"
|
||||
(N_ "Report Options") (N_ "From")
|
||||
"a" (N_ "Report start date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 0)
|
||||
@@ -809,26 +809,30 @@
|
||||
;; to-date
|
||||
(gnc:register-budget-report-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "To"
|
||||
"b" "Report end date"
|
||||
(N_ "Report Options") (N_ "To")
|
||||
"b" (N_ "Report end date")
|
||||
(lambda () (cons 'absolute (cons (current-time) 0)))
|
||||
#f 'absolute #f))
|
||||
|
||||
;; view
|
||||
(gnc:register-budget-report-option
|
||||
(gnc:make-multichoice-option
|
||||
"Report Options" "View"
|
||||
"c" "Type of budget report"
|
||||
(N_ "Report Options") (N_ "View")
|
||||
"c" (N_ "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?"))))
|
||||
(list (list->vector
|
||||
(list 'full
|
||||
(N_ "Full")
|
||||
(N_ "Show all columns")))
|
||||
(list->vector
|
||||
(list 'balancing
|
||||
(N_ "Balancing")
|
||||
(N_ "A report useful for balancing the budget")))
|
||||
(list->vector
|
||||
(list 'status
|
||||
(N_ "Status")
|
||||
(N_ "How are you doing on your budget?"))))))
|
||||
|
||||
gnc:*budget-report-options*)
|
||||
|
||||
(define (gnc:date-to-N-fraction caltime type)
|
||||
|
||||
@@ -4,8 +4,6 @@
|
||||
|
||||
(let ()
|
||||
|
||||
(define string-db (gnc:make-string-database))
|
||||
|
||||
(define (folio-options-generator)
|
||||
|
||||
(define gnc:*folio-report-options* (gnc:new-options))
|
||||
@@ -14,8 +12,8 @@
|
||||
|
||||
(gnc:register-folio-option
|
||||
(gnc:make-date-option
|
||||
"Portfolio Options" "At"
|
||||
"a" "Calculate stock portfolio value at this date"
|
||||
(N_ "Portfolio Options") (N_ "At")
|
||||
"a" (N_ "Calculate stock portfolio value at this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 59)
|
||||
@@ -28,8 +26,8 @@
|
||||
gnc:*folio-report-options*)
|
||||
|
||||
(define (titles)
|
||||
(map (lambda (key) (string-db 'lookup key))
|
||||
'(name ticker shares recent value cost profit-loss)))
|
||||
(list (_ "Name") (_ "Ticker") (_ "Shares") (_ "Recent Price")
|
||||
(_ "Value") (_ "Cost") (_ "Profit/Loss")))
|
||||
|
||||
(define (gnc:account-get-last-split account)
|
||||
(let ((num-splits (gnc:account-get-split-count account)))
|
||||
@@ -74,7 +72,7 @@
|
||||
(let ((value (total-value 'total #f))
|
||||
(cost (total-cost 'total #f))
|
||||
(print-info (gnc:default-print-info #f)))
|
||||
(list (html-strong (string-db 'lookup 'net))
|
||||
(list (html-strong (_ "Net"))
|
||||
" " " " " "
|
||||
(gnc:amount->string value print-info)
|
||||
(gnc:amount->string cost print-info)
|
||||
@@ -104,20 +102,10 @@
|
||||
|
||||
(define (folio-renderer options)
|
||||
(list
|
||||
(html-start-document-title (string-db 'lookup 'title) "#bfdeba")
|
||||
(html-table (string-db 'lookup 'title) (titles) (report-rows))
|
||||
(html-start-document-title (_ "Stock Portfolio Valuation") "#bfdeba")
|
||||
(html-table (_ "Stock Portfolio Valuation") (titles) (report-rows))
|
||||
(html-end-document)))
|
||||
|
||||
(string-db 'store 'title "Stock Portfolio Valuation")
|
||||
(string-db 'store 'name "Name")
|
||||
(string-db 'store 'ticker "Ticker")
|
||||
(string-db 'store 'shares "Shares")
|
||||
(string-db 'store 'recent "Recent Price")
|
||||
(string-db 'store 'value "Value")
|
||||
(string-db 'store 'cost "Cost")
|
||||
(string-db 'store 'profit-loss "Profit/Loss")
|
||||
(string-db 'store 'net "Net")
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name "Stock Portfolio"
|
||||
|
||||
@@ -32,8 +32,8 @@
|
||||
;; the mouse pointer over the option.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Hello, World!" "Boolean Option"
|
||||
"a" "This is a boolean option." #t))
|
||||
(N_ "Hello, World!") (N_ "Boolean Option")
|
||||
"a" (N_ "This is a boolean option.") #t))
|
||||
|
||||
;; This is a multichoice option. The user can choose between
|
||||
;; the values 'first, 'second, 'third, or 'fourth. These are guile
|
||||
@@ -42,12 +42,24 @@
|
||||
;; value is 'third.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-multichoice-option
|
||||
"Hello, World!" "Multi Choice Option"
|
||||
"b" "This is a multi choice option." 'third
|
||||
(list #(first "First Option" "Help for first option")
|
||||
#(second "Second Option" "Help for second option")
|
||||
#(third "Third Option" "Help for third option")
|
||||
#(fourth "Fourth Options" "The fourth option rules!"))))
|
||||
(N_ "Hello, World!") (N_ "Multi Choice Option")
|
||||
"b" (N_ "This is a multi choice option.") 'third
|
||||
(list (list->vector
|
||||
(list 'first
|
||||
(N_ "First Option")
|
||||
(N_ "Help for first option")))
|
||||
(list->vector
|
||||
(list 'second
|
||||
(N_ "Second Option")
|
||||
(N_ "Help for second option")))
|
||||
(list->vector
|
||||
(list 'third
|
||||
(N_ "Third Option")
|
||||
(N_ "Help for third option")))
|
||||
(list->vector
|
||||
(list 'fourth
|
||||
(N_ "Fourth Options")
|
||||
(N_ "The fourth option rules!"))))))
|
||||
|
||||
;; This is a string option. Users can type anything they want
|
||||
;; as a value. The default value is "Hello, World". This is
|
||||
@@ -56,8 +68,8 @@
|
||||
;; other key is 'a'.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-string-option
|
||||
"Hello, World!" "String Option"
|
||||
"c" "This is a string option" "Hello, World"))
|
||||
(N_ "Hello, World!") (N_ "String Option")
|
||||
"c" (N_ "This is a string option") (N_ "Hello, World")))
|
||||
|
||||
;; This is a date/time option. The user can pick a date and,
|
||||
;; possibly, a time. Times are stored as a pair
|
||||
@@ -67,8 +79,8 @@
|
||||
;; time.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-date-option
|
||||
"Hello, World!" "Just a Date Option"
|
||||
"d" "This is a date option"
|
||||
(N_ "Hello, World!") (N_ "Just a Date Option")
|
||||
"d" (N_ "This is a date option")
|
||||
(lambda () (cons 'absolute (cons (current-time) 0)))
|
||||
#f 'absolute #f ))
|
||||
|
||||
@@ -76,22 +88,22 @@
|
||||
;; the time.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-date-option
|
||||
"Hello, World!" "Time and Date Option"
|
||||
"e" "This is a date option with time"
|
||||
(N_ "Hello, World!") (N_ "Time and Date Option")
|
||||
"e" (N_ "This is a date option with time")
|
||||
(lambda () (cons 'absolute (cons (current-time) 0)))
|
||||
#t 'absolute #f ))
|
||||
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-date-option
|
||||
"Hello, World!" "Combo Date Option"
|
||||
"y" "This is a combination date option"
|
||||
(N_ "Hello, World!") (N_ "Combo Date Option")
|
||||
"y" (N_ "This is a combination date option")
|
||||
(lambda () (cons 'relative 'start-cal-year))
|
||||
#f 'both '(start-cal-year start-prev-year end-prev-year) ))
|
||||
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-date-option
|
||||
"Hello, World!" "Relative Date Option"
|
||||
"x" "This is a relative date option"
|
||||
(N_ "Hello, World!") (N_ "Relative Date Option")
|
||||
"x" (N_ "This is a relative date option")
|
||||
(lambda () (cons 'relative 'start-cal-year))
|
||||
#f 'relative '(start-cal-year start-prev-year end-prev-year) ))
|
||||
|
||||
@@ -101,8 +113,8 @@
|
||||
;; by a single click is given by the step size.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-number-range-option
|
||||
"Hello, World!" "Number Option"
|
||||
"ee" "This is a number option."
|
||||
(N_ "Hello, World!") (N_ "Number Option")
|
||||
"ee" (N_ "This is a number option.")
|
||||
1500.0 ;; default
|
||||
0.0 ;; lower bound
|
||||
10000.0 ;; upper bound
|
||||
@@ -119,8 +131,8 @@
|
||||
;; which will scale the values appropriately according the range.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-color-option
|
||||
"Hello, World!" "Background Color"
|
||||
"f" "This is a color option"
|
||||
(N_ "Hello, World!") (N_ "Background Color")
|
||||
"f" (N_ "This is a color option")
|
||||
(list #xf6 #xff #xdb 0)
|
||||
255
|
||||
#f))
|
||||
@@ -142,8 +154,8 @@
|
||||
;; selected account in the main window, if any.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-account-list-option
|
||||
"Hello Again" "An account list option"
|
||||
"g" "This is an account list option"
|
||||
(N_ "Hello Again") (N_ "An account list option")
|
||||
"g" (N_ "This is an account list option")
|
||||
(lambda () (gnc:get-current-accounts))
|
||||
#f #t))
|
||||
|
||||
@@ -153,21 +165,30 @@
|
||||
;; option is a list of symbols.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-list-option
|
||||
"Hello Again" "A list option"
|
||||
"h" "This is a list option"
|
||||
(N_ "Hello Again") (N_ "A list option")
|
||||
"h" (N_ "This is a list option")
|
||||
(list 'good)
|
||||
(list #(good "The Good" "Good option")
|
||||
#(bad "The Bad" "Bad option")
|
||||
#(ugly "The Ugly" "Ugly option"))))
|
||||
(list (list->vector
|
||||
(list 'good
|
||||
(N_ "The Good")
|
||||
(N_ "Good option")))
|
||||
(list->vector
|
||||
(list 'bad
|
||||
(N_ "The Bad")
|
||||
(N_ "Bad option")))
|
||||
(list->vector
|
||||
(list 'ugly
|
||||
(N_ "The Ugly")
|
||||
(N_ "Ugly option"))))))
|
||||
|
||||
;; This option is for testing. When true, the report generates
|
||||
;; an exception.
|
||||
(gnc:register-hello-world-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Testing" "Crash the report"
|
||||
"a" (string-append "This is for testing. "
|
||||
"Your reports probably shouldn't have an "
|
||||
"option like this.") #f))
|
||||
(N_ "Testing") (N_ "Crash the report")
|
||||
"a" (N_ "This is for testing. \
|
||||
Your reports probably shouldn't have an \
|
||||
option like this.") #f))
|
||||
|
||||
(gnc:options-set-default-section gnc:*hello-world-options*
|
||||
"Hello, World!")
|
||||
|
||||
@@ -151,15 +151,13 @@
|
||||
(define (lx-collector level action value)
|
||||
((vector-ref levelx-collector (- level 1)) action value))
|
||||
|
||||
(define string-db (gnc:make-string-database))
|
||||
|
||||
;; IRS asked congress to make the tax quarters sthe same as real quarters
|
||||
;; This is the year it is effective. THIS IS A Y10K BUG!
|
||||
(define tax-qtr-real-qtr-year 10000)
|
||||
|
||||
(define tax-tab-title "TAX Report Options")
|
||||
(define tax-tab-title (N_ "TAX Report Options"))
|
||||
|
||||
(define hierarchical-tab-title "Hierarchical Options")
|
||||
(define hierarchical-tab-title (N_ "Hierarchical Options"))
|
||||
|
||||
(define (tax-options-generator)
|
||||
(options-generator #f tax-tab-title))
|
||||
@@ -175,8 +173,8 @@
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-date-option
|
||||
tab-title "From"
|
||||
"a" "Start of reporting period"
|
||||
tab-title (N_ "From")
|
||||
"a" (N_ "Start of reporting period")
|
||||
(lambda ()
|
||||
(let ((bdtm (gnc:timepair->date (gnc:timepair-canonical-day-time
|
||||
(cons (current-time) 0)))))
|
||||
@@ -187,8 +185,8 @@
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-date-option
|
||||
tab-title "To"
|
||||
"b" "End of reporting period"
|
||||
tab-title (N_ "To")
|
||||
"b" (N_ "End of reporting period")
|
||||
(lambda ()
|
||||
(cons 'absolute (gnc:timepair-canonical-day-time
|
||||
(cons (current-time) 0))))
|
||||
@@ -196,98 +194,122 @@
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-multichoice-option
|
||||
tab-title "Alternate Period"
|
||||
"c" "Overide or modify From: & To:" 'from-to
|
||||
(list #(from-to "Use From - To" "Use From - To period")
|
||||
#(1st-est "1st Est Tax Quarter" "Jan 1 - Mar 31")
|
||||
#(2nd-est "2nd Est Tax Quarter" "Apr 1 - May 31")
|
||||
#(3rd-est "3rd Est Tax Quarter" "Jun 1 - Aug 31")
|
||||
#(4th-est "4th Est Tax Quarter" "Sep 1 - Dec 31")
|
||||
#(last-year "Last Year" "Last Year")
|
||||
#(1st-last "Last Yr 1st Est Tax Qtr" "Jan 1 - Mar 31, Last year")
|
||||
#(2nd-last "Last Yr 2nd Est Tax Qtr" "Apr 1 - May 31, Last year")
|
||||
#(3rd-last "Last Yr 3rd Est Tax Qtr" "Jun 1 - Aug 31, Last year")
|
||||
#(4th-last "Last Yr 4th Est Tax Qtr" "Sep 1 - Dec 31, Last year")
|
||||
)))
|
||||
|
||||
tab-title (N_ "Alternate Period")
|
||||
"c" (N_ "Overide or modify From: & To:") 'from-to
|
||||
(list (list->vector
|
||||
(list 'from-to (N_ "Use From - To") (N_ "Use From - To period")))
|
||||
(list->vector
|
||||
(list '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31")))
|
||||
(list->vector
|
||||
(list '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31")))
|
||||
(list->vector
|
||||
(list '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31")))
|
||||
(list->vector
|
||||
(list '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31")))
|
||||
(list->vector
|
||||
(list 'last-year (N_ "Last Year") (N_ "Last Year")))
|
||||
(list->vector
|
||||
(list '1st-last (N_ "Last Yr 1st Est Tax Qtr")
|
||||
(N_ "Jan 1 - Mar 31, Last year")))
|
||||
(list->vector
|
||||
(list '2nd-last (N_ "Last Yr 2nd Est Tax Qtr")
|
||||
(N_ "Apr 1 - May 31, Last year")))
|
||||
(list->vector
|
||||
(list '3rd-last (N_ "Last Yr 3rd Est Tax Qtr")
|
||||
(N_ "Jun 1 - Aug 31, Last year")))
|
||||
(list->vector
|
||||
(list '4th-last (N_ "Last Yr 4th Est Tax Qtr")
|
||||
(N_ "Sep 1 - Dec 31, Last year"))))))
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-account-list-option
|
||||
tab-title "Select Accounts (none = all)"
|
||||
"d" "Select accounts"
|
||||
tab-title (N_ "Select Accounts (none = all)")
|
||||
"d" (N_ "Select accounts")
|
||||
(lambda () (gnc:get-current-accounts))
|
||||
#f
|
||||
#t))
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-simple-boolean-option
|
||||
tab-title "Suppress $0.00 values"
|
||||
"f" "$0.00 valued Accounts won't be printed." #t))
|
||||
tab-title (N_ "Suppress $0.00 values")
|
||||
"f" (N_ "$0.00 valued Accounts won't be printed.") #t))
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-simple-boolean-option
|
||||
tab-title "Print Full account names"
|
||||
"g" "Print all Parent account names" #f))
|
||||
tab-title (N_ "Print Full account names")
|
||||
"g" (N_ "Print all Parent account names") #f))
|
||||
|
||||
(if (not hierarchical?)
|
||||
(begin
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-multichoice-option
|
||||
tab-title "Set/Reset Tax Status"
|
||||
"h" "Set/Reset Selected Account Tax Status" 'tax-no-change
|
||||
(list #(tax-no-change "No Change" "No Change")
|
||||
#(tax-set "Set Tax Related" "Set Selected accounts as Tax\
|
||||
Related")
|
||||
#(tax-reset "Reset Tax Related"
|
||||
"Reset Selected accounts as not Tax Related")
|
||||
#(tax-set-kids "Set Tax Related & sub-accounts"
|
||||
"Set Selected & sub-accounts as Tax Related")
|
||||
#(tax-reset-kids
|
||||
"Reset Tax Related & sub-accounts"
|
||||
"Reset Selected & sub-accounts as not Tax Related")
|
||||
tab-title (N_ "Set/Reset Tax Status")
|
||||
"h" (N_ "Set/Reset Selected Account Tax Status") 'tax-no-change
|
||||
(list (list->vector
|
||||
(list 'tax-no-change (N_ "No Change") (N_ "No Change")))
|
||||
(list->vector
|
||||
(list 'tax-set (N_ "Set Tax Related")
|
||||
(N_ "Set Selected accounts as Tax Related")))
|
||||
(list->vector
|
||||
(list 'tax-reset (N_ "Reset Tax Related")
|
||||
(N_ "Reset Selected accounts as not Tax Related")))
|
||||
(list->vector
|
||||
(list 'tax-set-kids (N_ "Set Tax Related & sub-accounts")
|
||||
(N_ "Set Selected & sub-accounts as Tax Related")))
|
||||
(list->vector
|
||||
(list 'tax-reset-kids
|
||||
(N_ "Reset Tax Related & sub-accounts")
|
||||
(N_ "Reset Selected & sub-accounts as not Tax Related")))
|
||||
)))
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-account-list-option
|
||||
"TXF Export Init" "Select Account"
|
||||
"a" "Select Account"
|
||||
(N_ "TXF Export Init") (N_ "Select Account")
|
||||
"a" (N_ "Select Account")
|
||||
(lambda () (gnc:get-current-accounts))
|
||||
#f
|
||||
#t))
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"TXF Export Init" "Print extended TXF HELP messages"
|
||||
"b" "Print TXF HELP" #f))
|
||||
(N_ "TXF Export Init") (N_ "Print extended TXF HELP messages")
|
||||
"b" (N_ "Print TXF HELP") #f))
|
||||
|
||||
(gnc:register-tax-option
|
||||
;;(gnc:make-multichoice-option
|
||||
(gnc:make-list-option
|
||||
"TXF Export Init" "For INCOME accounts, select here. < ^ #\
|
||||
see help"
|
||||
"c" "Select a TXF Income catagory"
|
||||
(N_ "TXF Export Init")
|
||||
(N_ "For INCOME accounts, select here. < ^ # see help")
|
||||
"c" (N_ "Select a TXF Income catagory")
|
||||
'()
|
||||
txf-income-catagories
|
||||
))
|
||||
|
||||
|
||||
(gnc:register-tax-option
|
||||
;;(gnc:make-multichoice-option
|
||||
(gnc:make-list-option
|
||||
"TXF Export Init" "For EXPENSE accounts, select here. < ^ #\
|
||||
see help"
|
||||
"d" "Select a TXF Expense catagory"
|
||||
(N_ "TXF Export Init")
|
||||
(N_ "For EXPENSE accounts, select here. < ^ # see help")
|
||||
"d" (N_ "Select a TXF Expense catagory")
|
||||
'()
|
||||
txf-expense-catagories
|
||||
))
|
||||
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-multichoice-option
|
||||
"TXF Export Init" "< ^ Payer Name source"
|
||||
"e" "Select the source of the Payer Name" 'default
|
||||
(list #(default "Default" "Use Indicated Default")
|
||||
#(current "< Current Account" "Use Current Account Name")
|
||||
#(parent "^ Parent Account" "Use Parent Account Name")
|
||||
(N_ "TXF Export Init") (N_ "< ^ Payer Name source")
|
||||
"e" (N_ "Select the source of the Payer Name") 'default
|
||||
(list (list->vector
|
||||
(list 'default (N_ "Default")
|
||||
(N_ "Use Indicated Default")))
|
||||
(list->vector
|
||||
(list 'current (N_ "< Current Account")
|
||||
(N_ "Use Current Account Name")))
|
||||
(list->vector
|
||||
(list 'parent (N_ "^ Parent Account")
|
||||
(N_ "Use Parent Account Name")))
|
||||
)))))
|
||||
|
||||
|
||||
gnc:*tax-report-options*)
|
||||
|
||||
(define tax-key "{tax}")
|
||||
@@ -570,10 +592,15 @@
|
||||
'())))
|
||||
txf-dups-alist))))
|
||||
(if (not (null? dups))
|
||||
(cons (html-para (html-blue (string-db 'lookup 'txf-dup)))
|
||||
(map html-para (map html-blue dups)))
|
||||
(cons
|
||||
(html-para
|
||||
(html-blue
|
||||
(_ "ERROR: There are duplicate TXF codes assigned\
|
||||
to some accounts. Only TXF codes prefixed with \"<\" or \"^\" may be\
|
||||
repeated.")))
|
||||
(map html-para (map html-blue dups)))
|
||||
'())))
|
||||
|
||||
|
||||
;; some codes require special handling
|
||||
(define (txf-special-split? code)
|
||||
(member code '("N521"))) ; only one for now
|
||||
@@ -743,8 +770,8 @@
|
||||
(apply max (gnc:group-map-accounts
|
||||
(lambda (x) (num-generations x (+ 1 gen)))
|
||||
children)))))
|
||||
|
||||
(let* ((hierarchical? (equal? (string-db 'lookup 'hierarchical-title)
|
||||
|
||||
(let* ((hierarchical? (equal? (_ "Hierarchical Accounts Report")
|
||||
report-name))
|
||||
(tab-title (if hierarchical? hierarchical-tab-title tax-tab-title))
|
||||
(from-value (gnc:date-option-absolute-time
|
||||
@@ -1012,7 +1039,7 @@
|
||||
(txf-last-payer "")
|
||||
(txf-l-count 0)
|
||||
(report-title (if txf-help
|
||||
(string-db 'lookup 'txf-title)
|
||||
(_ "Detailed TXF Category Descriptions")
|
||||
report-name))
|
||||
(file-name "????"))
|
||||
|
||||
@@ -1022,7 +1049,7 @@
|
||||
((> i MAX-LEVELS) i)
|
||||
(lx-collector i 'reset #f))
|
||||
(set! txf-dups-alist '())
|
||||
|
||||
|
||||
(if (not tax-mode-in) ; First do Txf mode, if set
|
||||
(begin
|
||||
(set! file-name ; get file name from user
|
||||
@@ -1087,9 +1114,9 @@
|
||||
"<p>"
|
||||
(if txf-help
|
||||
""
|
||||
(html-black (string-append (string-db 'lookup 'tax-from)
|
||||
from-date
|
||||
(string-db 'lookup 'tax-to)
|
||||
(html-black (string-append (_ "Period From:") " "
|
||||
from-date " "
|
||||
(_ "To:") " "
|
||||
to-date)))
|
||||
"</p>\n"
|
||||
"<p>"
|
||||
@@ -1098,11 +1125,13 @@
|
||||
(if tax-mode-in
|
||||
(if txf-help
|
||||
""
|
||||
(string-db 'lookup 'txf-may))
|
||||
(_ "Blue items are exportable to a TXF file"))
|
||||
(if file-name
|
||||
(string-append (string-db 'lookup 'txf-was)
|
||||
file-name "\"")
|
||||
(string-db 'lookup 'txf-not)))))
|
||||
(string-append
|
||||
(_ "Blue items were exported to file: \"")
|
||||
file-name "\"")
|
||||
(_ "Blue items were <b>NOT</b> exported to \
|
||||
txf file!")))))
|
||||
"</p>\n"
|
||||
"</center>"
|
||||
(if (or hierarchical? txf-help)
|
||||
@@ -1113,60 +1142,38 @@
|
||||
"<tr>"
|
||||
"<th>"
|
||||
(if txf-help
|
||||
(list (string-db 'lookup 'txf-form-code) "<br>"
|
||||
(string-db 'lookup 'txf-desc))
|
||||
(string-db 'lookup 'account-name))
|
||||
(list (_ "Tax Form \\ TXF Code") "<br>"
|
||||
(_ "Description"))
|
||||
(_ "Account Name"))
|
||||
"</th>\n"
|
||||
(if txf-help
|
||||
""
|
||||
(do ((i (- max-level 1) (- i 1))
|
||||
(head "" (string-append
|
||||
head "<th align=right>" (string-db 'lookup 'sub)
|
||||
head "<th align=right>" (_ "(Sub ")
|
||||
(number->string i) ")</th>")))
|
||||
((< i 1) head)))
|
||||
(if txf-help
|
||||
(list "<th>" (string-db 'lookup 'txf-help)
|
||||
(list "<th>" (_ "Extended TXF Help messages")
|
||||
(html-blue " Income") (html-red " Expense"))
|
||||
(list "<th align=right>" (string-db 'lookup 'balance)))
|
||||
(list "<th align=right>" (_ "Total")))
|
||||
"</th>\n"
|
||||
"</tr>\n"
|
||||
output
|
||||
"</table>\n"
|
||||
(if (null? (car output))
|
||||
(string-append "<p><b>" (string-db 'lookup (if hierarchical?
|
||||
'no-hierarchical
|
||||
'no-tax))
|
||||
"</b></p>\n")
|
||||
(string-append
|
||||
"<p><b>"
|
||||
(if hierarchical?
|
||||
(_ "No accounts were found.")
|
||||
(_ "No Tax Related accounts were found. Click \
|
||||
\"Parameters\" to set some with the \"Set/Reset Tax Status:\" parameter."))
|
||||
"</b></p>\n")
|
||||
" ")
|
||||
"</body>"
|
||||
"</html>")
|
||||
)))
|
||||
|
||||
(string-db 'store 'net "Net")
|
||||
(string-db 'store 'account-name "Account Name")
|
||||
(string-db 'store 'no-tax "No Tax Related accounts were found. Click \
|
||||
\"Parameters\" to set some with the \"Set/Reset Tax Status:\" parameter.")
|
||||
(string-db 'store 'no-hierarchical "No accounts were found.")
|
||||
(string-db 'store 'txf-may "Blue items are exportable to a TXF file")
|
||||
(string-db 'store 'txf-was "Blue items were exported to file: \"")
|
||||
(string-db 'store 'txf-not "Blue items were <b>NOT</b> exported to txf \
|
||||
file!")
|
||||
(string-db 'store 'sub "(Sub ")
|
||||
(string-db 'store 'balance "Total")
|
||||
(string-db 'store 'hierarchical-title "Hierarchical Accounts Report")
|
||||
(string-db 'store 'txf-title "Detailed TXF Category Descriptions")
|
||||
(string-db 'store 'tax-title "Taxable Income / Deductible Expenses")
|
||||
(string-db 'store 'tax-from "Period From: ")
|
||||
(string-db 'store 'tax-to " To: ")
|
||||
(string-db 'store 'tax-desc "This page shows your Taxable Income and \
|
||||
Deductable Expenses.")
|
||||
(string-db 'store 'txf-form-code "Tax Form \\ TXF Code")
|
||||
(string-db 'store 'txf-desc "Description")
|
||||
(string-db 'store 'txf-help "Extended TXF Help messages")
|
||||
(string-db 'store 'txf-dup "ERROR: There are duplicate TXF codes assigned\
|
||||
to some accounts. Only TXF codes prefixed with \"<\" or \"^\" may be\
|
||||
repeated.")
|
||||
|
||||
|
||||
;; copy help strings to catagory structures.
|
||||
(txf-help txf-income-catagories)
|
||||
(txf-help txf-expense-catagories)
|
||||
@@ -1177,9 +1184,10 @@ Deductable Expenses.")
|
||||
'name "Hierarchical"
|
||||
'options-generator hierarchical-options-generator
|
||||
'renderer (lambda (options)
|
||||
(generate-tax-or-txf
|
||||
(string-db 'lookup 'hierarchical-title)
|
||||
(string-db 'lookup 'tax-desc)
|
||||
(generate-tax-or-txf
|
||||
(_ "Hierarchical Accounts Report")
|
||||
(_ "This page shows your Taxable Income and \
|
||||
Deductable Expenses.")
|
||||
options
|
||||
#t)))
|
||||
|
||||
@@ -1188,9 +1196,10 @@ Deductable Expenses.")
|
||||
'name "Tax"
|
||||
'options-generator tax-options-generator
|
||||
'renderer (lambda (options)
|
||||
(generate-tax-or-txf
|
||||
(string-db 'lookup 'tax-title)
|
||||
(string-db 'lookup 'tax-desc)
|
||||
(generate-tax-or-txf
|
||||
(_ "Taxable Income / Deductible Expenses")
|
||||
(_ "This page shows your Taxable Income and \
|
||||
Deductable Expenses.")
|
||||
options
|
||||
#t)))
|
||||
|
||||
@@ -1199,8 +1208,9 @@ Deductable Expenses.")
|
||||
'name "Export .TXF"
|
||||
'options-generator tax-options-generator
|
||||
'renderer (lambda (options)
|
||||
(generate-tax-or-txf
|
||||
(string-db 'lookup 'tax-title)
|
||||
(string-db 'lookup 'tax-desc)
|
||||
(generate-tax-or-txf
|
||||
(_ "Taxable Income / Deductible Expenses")
|
||||
(_ "This page shows your Taxable Income and \
|
||||
Deductable Expenses.")
|
||||
options
|
||||
#f))))
|
||||
|
||||
@@ -10,12 +10,12 @@
|
||||
(gnc:depend "html-generator.scm")
|
||||
|
||||
(let ()
|
||||
(define string-db (gnc:make-string-database))
|
||||
|
||||
(define (gnc:split-get-sign-adjusted-value split)
|
||||
(let ((acc (gnc:split-get-account split))
|
||||
(unsigned-value (d-gnc:split-get-value split)))
|
||||
(gnc:debug "Adjusting value" unsigned-value (gnc:account-reverse-balance? acc))
|
||||
(gnc:debug "Adjusting value"
|
||||
unsigned-value (gnc:account-reverse-balance? acc))
|
||||
(if (gnc:account-reverse-balance? acc)
|
||||
(- unsigned-value)
|
||||
unsigned-value)))
|
||||
@@ -33,10 +33,10 @@
|
||||
(signed-balance (if (gnc:account-reverse-balance? acc)
|
||||
(- unsigned-balance)
|
||||
unsigned-balance)))
|
||||
|
||||
|
||||
(string-append acc-name
|
||||
" ("
|
||||
(string-db 'lookup 'open-bal-string)
|
||||
(_ "Opening Balance")
|
||||
" "
|
||||
(gnc:amount->string signed-balance
|
||||
(gnc:account-value-print-info acc #f))
|
||||
@@ -50,8 +50,8 @@
|
||||
(if
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Date"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'date-string)
|
||||
(make-report-spec
|
||||
(_ "Date")
|
||||
(lambda (split)
|
||||
(gnc:transaction-get-date-posted
|
||||
(gnc:split-get-parent split)))
|
||||
@@ -64,12 +64,12 @@
|
||||
#f ; subs-list-proc
|
||||
#f)
|
||||
#f)
|
||||
|
||||
|
||||
(if
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Num"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'num-string)
|
||||
(make-report-spec
|
||||
(_ "Num")
|
||||
(lambda (split)
|
||||
(gnc:transaction-get-num
|
||||
(gnc:split-get-parent split)))
|
||||
@@ -86,7 +86,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Description"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'desc-string)
|
||||
(_ "Description")
|
||||
(lambda (split)
|
||||
(gnc:transaction-get-description
|
||||
(gnc:split-get-parent split)))
|
||||
@@ -103,7 +103,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Memo"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'memo-string)
|
||||
(_ "Memo")
|
||||
gnc:split-get-memo
|
||||
(lambda (memo) (html-left-cell (html-string memo)))
|
||||
#f ; total-proc
|
||||
@@ -119,7 +119,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Account"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'acc-string)
|
||||
(_ "Account")
|
||||
(lambda (split)
|
||||
(gnc:account-get-full-name
|
||||
(gnc:split-get-account split)))
|
||||
@@ -140,7 +140,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Other Account"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'other-acc-string)
|
||||
(_ "Other Account")
|
||||
(lambda (split)
|
||||
(let ((others (gnc:split-get-other-splits split)))
|
||||
(if (null? others)
|
||||
@@ -160,7 +160,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Shares"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'shares-string)
|
||||
(_ "Shares")
|
||||
(lambda (split)
|
||||
(d-gnc:split-get-share-amount split))
|
||||
(lambda (num) (html-right-cell (html-string num)))
|
||||
@@ -176,7 +176,7 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Price"))
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'price-string)
|
||||
(_ "Price")
|
||||
(lambda (split)
|
||||
(d-gnc:split-get-share-price split))
|
||||
(lambda (num) (html-right-cell (html-string num)))
|
||||
@@ -192,7 +192,7 @@
|
||||
(eq? (gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Amount")) 'single)
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'amount-string)
|
||||
(_ "Amount")
|
||||
gnc:split-get-sign-adjusted-value
|
||||
(lambda (value) (html-right-cell (html-currency value)))
|
||||
+ ; total-proc
|
||||
@@ -202,21 +202,22 @@
|
||||
(html-right-cell (html-strong (html-currency value))))
|
||||
#t ; first-last-preference
|
||||
(lambda (split)
|
||||
(map gnc:split-get-sign-adjusted-value (gnc:split-get-other-splits split)))
|
||||
(map gnc:split-get-sign-adjusted-value
|
||||
(gnc:split-get-other-splits split)))
|
||||
(lambda (value)
|
||||
(html-right-cell (html-ital (html-currency value)))))
|
||||
#f)
|
||||
|
||||
(if
|
||||
(eq? (gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Amount")) 'double)
|
||||
(gnc:lookup-option options "Display" "Amount")) 'double)
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'debit-string)
|
||||
(lambda (split)
|
||||
(max 0 (gnc:split-get-sign-adjusted-value split)))
|
||||
(lambda (value)
|
||||
(cond ((> value 0.0) (html-right-cell (html-currency value)))
|
||||
(else (html-right-cell (html-ital (html-string " "))))))
|
||||
(_ "Debit")
|
||||
(lambda (split)
|
||||
(max 0 (gnc:split-get-sign-adjusted-value split)))
|
||||
(lambda (value)
|
||||
(cond ((> value 0.0) (html-right-cell (html-currency value)))
|
||||
(else (html-right-cell (html-ital (html-string " "))))))
|
||||
; (lambda (value)
|
||||
; (if (> value 0) (html-right-cell (html-currency value)))
|
||||
; (html-right-cell (html-ital (html-string " "))))
|
||||
@@ -227,12 +228,14 @@
|
||||
(html-right-cell (html-strong (html-currency value))))
|
||||
#t ; first-last-preference
|
||||
(lambda (split)
|
||||
(map gnc:split-get-sign-adjusted-value (gnc:split-get-other-splits split)))
|
||||
(map gnc:split-get-sign-adjusted-value
|
||||
(gnc:split-get-other-splits split)))
|
||||
; (lambda (value)
|
||||
; (if (> value 0) (html-right-cell (html-ital (html-currency value)))
|
||||
; (html-right-cell (html-ital (html-string " ")))))
|
||||
(lambda (value)
|
||||
(cond ((> value 0.0) (html-right-cell (html-ital(html-currency value))))
|
||||
(cond ((> value 0.0) (html-right-cell
|
||||
(html-ital(html-currency value))))
|
||||
(else (html-right-cell (html-ital (html-string " ")))))))
|
||||
#f)
|
||||
|
||||
@@ -240,7 +243,7 @@
|
||||
(eq? (gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Amount")) 'double)
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'credit-string)
|
||||
(_ "Credit")
|
||||
(lambda (split)
|
||||
(max 0 (- (gnc:split-get-sign-adjusted-value split))))
|
||||
; (lambda (value) (html-right-cell (html-currency value)))
|
||||
@@ -257,18 +260,19 @@
|
||||
(html-right-cell (html-strong (html-currency value))))
|
||||
#t ; first-last-preference
|
||||
(lambda (split)
|
||||
(map gnc:split-get-sign-adjusted-value (gnc:split-get-other-splits split)))
|
||||
(map gnc:split-get-sign-adjusted-value
|
||||
(gnc:split-get-other-splits split)))
|
||||
(lambda (value)
|
||||
(cond ((< value 0) (html-right-cell (html-ital (html-currency (- value)))))
|
||||
(else (html-right-cell (html-ital (html-string " ")))))))
|
||||
(cond ((< value 0)
|
||||
(html-right-cell (html-ital (html-currency (- value)))))
|
||||
(else (html-right-cell (html-ital (html-string " ")))))))
|
||||
#f)
|
||||
|
||||
|
||||
(if
|
||||
(eq? (gnc:option-value
|
||||
(gnc:lookup-option options "Display" "Amount")) 'double)
|
||||
(make-report-spec
|
||||
(string-db 'lookup 'total-string)
|
||||
(_ "Total")
|
||||
gnc:split-get-sign-adjusted-value
|
||||
;(lambda (value) (html-right-cell (html-currency value)))
|
||||
;(lambda (value) (html-right-cell (html-string "hello")))
|
||||
@@ -442,8 +446,8 @@
|
||||
;; hack alert - could somebody set this to an appropriate date?
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "From"
|
||||
"a" "Report Items from this date"
|
||||
(N_ "Report Options") (N_ "From")
|
||||
"a" (N_ "Report Items from this date")
|
||||
(lambda ()
|
||||
(let ((bdtime (localtime (current-time))))
|
||||
(set-tm:sec bdtime 0)
|
||||
@@ -459,16 +463,16 @@
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-date-option
|
||||
"Report Options" "To"
|
||||
"b" "Report items up to and including this date"
|
||||
(N_ "Report Options") (N_ "To")
|
||||
"b" (N_ "Report items up to and including this date")
|
||||
(lambda () (cons 'absolute (cons (current-time) 0)))
|
||||
#f 'absolute #f))
|
||||
|
||||
;; account to do report on
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-account-list-option
|
||||
"Report Options" "Account"
|
||||
"c" "Do transaction report on these accounts"
|
||||
(N_ "Report Options") (N_ "Account")
|
||||
"c" (N_ "Do transaction report on these accounts")
|
||||
(lambda ()
|
||||
(let ((current-accounts (gnc:get-current-accounts))
|
||||
(num-accounts (gnc:group-get-num-accounts
|
||||
@@ -482,8 +486,8 @@
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Report Options" "Style"
|
||||
"d" "Report style"
|
||||
(N_ "Report Options") (N_ "Style")
|
||||
"d" (N_ "Report style")
|
||||
;; XXX: merged style currently disabled because it breaks double-column
|
||||
;; amounts. If somebody wants it back just uncomment the commented code
|
||||
;; below
|
||||
@@ -492,151 +496,178 @@
|
||||
(list ;#(merged
|
||||
; "Merged"
|
||||
; "Display N-1 lines")
|
||||
#(multi-line
|
||||
"Multi-Line"
|
||||
"Display N lines")
|
||||
#(single
|
||||
"Single"
|
||||
"Display 1 line"))))
|
||||
(list->vector
|
||||
(list 'multi-line
|
||||
(N_ "Multi-Line")
|
||||
(N_ "Display N lines")))
|
||||
(list->vector
|
||||
(list 'single
|
||||
(N_ "Single")
|
||||
(N_ "Display 1 line"))))))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Report Options" "Only positive Entries"
|
||||
"da" "Display only positive Entries?" #f))
|
||||
|
||||
|
||||
(N_ "Report Options") (N_ "Only positive Entries")
|
||||
"da" (N_ "Display only positive Entries?") #f))
|
||||
|
||||
(let ((key-choice-list
|
||||
(list #(account
|
||||
"Account (w/subtotal)"
|
||||
"Sort & subtotal by account")
|
||||
#(date
|
||||
"Date"
|
||||
"Sort by date")
|
||||
#(date-monthly
|
||||
"Date (subtotal monthly)"
|
||||
"Sort by date & subtotal each month")
|
||||
#(date-yearly
|
||||
"Date (subtotal yearly)"
|
||||
"Sort by date & subtotal each year")
|
||||
#(time
|
||||
"Time"
|
||||
"Sort by exact entry time")
|
||||
#(corresponding-acc
|
||||
"Transfer from/to"
|
||||
"Sort by account transferred from/to's name")
|
||||
#(corresponding-acc-subtotal
|
||||
"Transfer from/to (w/subtotal)"
|
||||
"Sort and subtotal by account transferred from/to's name")
|
||||
#(amount
|
||||
"Amount"
|
||||
"Sort by amount")
|
||||
#(description
|
||||
"Description"
|
||||
"Sort by description")
|
||||
#(number
|
||||
"Number"
|
||||
"Sort by check/transaction number")
|
||||
#(memo
|
||||
"Memo"
|
||||
"Sort by memo")
|
||||
#(none
|
||||
"None"
|
||||
"Do not sort"))))
|
||||
(list (list->vector
|
||||
(list 'account
|
||||
(N_ "Account (w/subtotal)")
|
||||
(N_ "Sort & subtotal by account")))
|
||||
(list->vector
|
||||
(list 'date
|
||||
(N_ "Date")
|
||||
(N_ "Sort by date")))
|
||||
(list->vector
|
||||
(list 'date-monthly
|
||||
(N_ "Date (subtotal monthly)")
|
||||
(N_ "Sort by date & subtotal each month")))
|
||||
(list->vector
|
||||
(list 'date-yearly
|
||||
(N_ "Date (subtotal yearly)")
|
||||
(N_ "Sort by date & subtotal each year")))
|
||||
(list->vector
|
||||
(list 'time
|
||||
(N_ "Time")
|
||||
(N_ "Sort by exact entry time")))
|
||||
(list->vector
|
||||
(list 'corresponding-acc
|
||||
(N_ "Transfer from/to")
|
||||
(N_ "Sort by account transferred from/to's name")))
|
||||
(list->vector
|
||||
(list 'corresponding-acc-subtotal
|
||||
(N_ "Transfer from/to (w/subtotal)")
|
||||
(N_ "Sort and subtotal by account transferred from/to's name")))
|
||||
(list->vector
|
||||
(list 'amount
|
||||
(N_ "Amount")
|
||||
(N_ "Sort by amount")))
|
||||
(list->vector
|
||||
(list 'description
|
||||
(N_ "Description")
|
||||
(N_ "Sort by description")))
|
||||
(list->vector
|
||||
(list 'number
|
||||
(N_ "Number")
|
||||
(N_ "Sort by check/transaction number")))
|
||||
(list->vector
|
||||
(list 'memo
|
||||
(N_ "Memo")
|
||||
(N_ "Sort by memo")))
|
||||
(list->vector
|
||||
(list 'none
|
||||
(N_ "None")
|
||||
(N_ "Do not sort"))))))
|
||||
|
||||
;; primary sorting criterion
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Sorting" "Primary Key"
|
||||
"a" "Sort by this criterion first"
|
||||
(N_ "Sorting") (N_ "Primary Key")
|
||||
"a" (N_ "Sort by this criterion first")
|
||||
'account
|
||||
key-choice-list))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Sorting" "Primary Sort Order"
|
||||
"b" "Order of primary sorting"
|
||||
(N_ "Sorting") (N_ "Primary Sort Order")
|
||||
"b" (N_ "Order of primary sorting")
|
||||
'ascend
|
||||
(list
|
||||
#(ascend "Ascending" "smallest to largest, earliest to latest")
|
||||
#(descend "Descending" "largest to smallest, latest to earliest"))))
|
||||
(list->vector
|
||||
(list 'ascend
|
||||
(N_ "Ascending")
|
||||
(N_ "smallest to largest, earliest to latest")))
|
||||
(list->vector
|
||||
(list 'descend
|
||||
(N_ "Descending")
|
||||
(N_ "largest to smallest, latest to earliest"))))))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Sorting" "Secondary Key"
|
||||
(N_ "Sorting") (N_ "Secondary Key")
|
||||
"c"
|
||||
"Sort by this criterion second"
|
||||
(N_ "Sort by this criterion second")
|
||||
'date
|
||||
key-choice-list))
|
||||
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Sorting" "Secondary Sort Order"
|
||||
"d" "Order of Secondary sorting"
|
||||
(N_ "Sorting") (N_ "Secondary Sort Order")
|
||||
"d" (N_ "Order of Secondary sorting")
|
||||
'ascend
|
||||
(list
|
||||
#(ascend "Ascending" "smallest to largest, earliest to latest")
|
||||
#(descend "Descending" "largest to smallest, latest to earliest")))))
|
||||
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Date"
|
||||
"b" "Display the date?" #t))
|
||||
(list->vector
|
||||
(list 'ascend
|
||||
(N_ "Ascending")
|
||||
(N_ "smallest to largest, earliest to latest")))
|
||||
(list->vector
|
||||
(list 'descend
|
||||
(N_ "Descending")
|
||||
(N_ "largest to smallest, latest to earliest")))))))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Num"
|
||||
"c" "Display the cheque number?" #t))
|
||||
(N_ "Display") (N_ "Date")
|
||||
"b" (N_ "Display the date?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Description"
|
||||
"d" "Display the description?" #t))
|
||||
(N_ "Display") (N_ "Num")
|
||||
"c" (N_ "Display the cheque number?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Memo"
|
||||
"f" "Display the memo?" #t))
|
||||
(N_ "Display") (N_ "Description")
|
||||
"d" (N_ "Display the description?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Account"
|
||||
"g" "Display the account?" #t))
|
||||
(N_ "Display") (N_ "Memo")
|
||||
"f" (N_ "Display the memo?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Other Account"
|
||||
"h" "Display the other account? (if this is a split transaction, this parameter is guessed)." #f))
|
||||
(N_ "Display") (N_ "Account")
|
||||
"g" (N_ "Display the account?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Shares"
|
||||
"ha" "Display the number of shares?" #f))
|
||||
(N_ "Display") (N_ "Other Account")
|
||||
"h" (N_ "Display the other account? (if this is a split transaction, this parameter is guessed).") #f))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Price"
|
||||
(N_ "Display") (N_ "Shares")
|
||||
"ha" (N_ "Display the number of shares?") #f))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
(N_ "Display") (N_ "Price")
|
||||
"hb" "Display the shares price?" #f))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-multichoice-option
|
||||
"Display" "Amount"
|
||||
"i" "Display the amount?"
|
||||
|
||||
(N_ "Display") (N_ "Amount")
|
||||
"i" (N_ "Display the amount?")
|
||||
'single
|
||||
(list #(none "None" "No amount display")
|
||||
#(single "Single" "Single Column Display")
|
||||
#(double "Double" "Two Column Display"))))
|
||||
(list
|
||||
(list->vector
|
||||
(list 'none (N_ "None") (N_ "No amount display")))
|
||||
(list->vector
|
||||
(list 'single (N_ "Single") (N_ "Single Column Display")))
|
||||
(list->vector
|
||||
(list 'double (N_ "Double") (N_ "Two Column Display"))))))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Headers" "j" "Display the headers?" #t))
|
||||
|
||||
(N_ "Display") (N_ "Headers")
|
||||
"j" (N_ "Display the headers?") #t))
|
||||
|
||||
(gnc:register-trep-option
|
||||
(gnc:make-simple-boolean-option
|
||||
"Display" "Totals"
|
||||
"k" "Display the totals?" #t))
|
||||
(N_ "Display") (N_ "Totals")
|
||||
"k" (N_ "Display the totals?") #t))
|
||||
|
||||
(gnc:options-set-default-section gnc:*transaction-report-options*
|
||||
"Report Options")
|
||||
@@ -699,7 +730,7 @@
|
||||
(split-report-specs (make-split-report-spec options)))
|
||||
|
||||
(list
|
||||
(html-start-document-title (string-db 'lookup 'title) #f)
|
||||
(html-start-document-title (_ "Transaction Report") #f)
|
||||
(html-start-table)
|
||||
(if (gnc:option-value (gnc:lookup-option options "Display" "Headers"))
|
||||
(html-table-headers split-report-specs)
|
||||
@@ -725,24 +756,8 @@
|
||||
(html-end-table)
|
||||
(html-end-document))))
|
||||
|
||||
|
||||
(string-db 'store 'title "Transaction Report")
|
||||
(string-db 'store 'date-string "Date")
|
||||
(string-db 'store 'num-string "Num")
|
||||
(string-db 'store 'desc-string "Description")
|
||||
(string-db 'store 'memo-string "Memo")
|
||||
(string-db 'store 'acc-string "Account")
|
||||
(string-db 'store 'other-acc-string "Other Account")
|
||||
(string-db 'store 'shares-string "Shares")
|
||||
(string-db 'store 'price-string "Price")
|
||||
(string-db 'store 'amount-string "Amount")
|
||||
(string-db 'store 'debit-string "Debit")
|
||||
(string-db 'store 'credit-string "Credit")
|
||||
(string-db 'store 'total-string "Total")
|
||||
(string-db 'store 'open-bal-string "Opening Balance")
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (string-db 'lookup 'title)
|
||||
'name (_ "Transaction Report")
|
||||
'options-generator trep-options-generator
|
||||
'renderer gnc:trep-renderer))
|
||||
|
||||
Reference in New Issue
Block a user