IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

* src/scm/html-table.scm ((gnc:make-html-table-header-cell/markup

Browse Source 
markup . objects)): new func

	* src/scm/report/taxtxf.scm: more work on porting

	* src/scm/html-style-sheet.scm: add "<number-cell>" and
	"<number-header>" styles.

	* src/scm/report/account-summary.scm: use "Total" not "Net
	Assets". This is a general report, not just limited to asset
	accounts.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3769 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-03-12 11:51:47 +00:00
parent 2fccd6bb1f
commit f27cb73c90
5 changed files with 210 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ChangeLog
View File

@ -1,3 +1,17 @@
2001-03-12 Dave Peticolas <dave@krondo.com>
* src/scm/html-table.scm ((gnc:make-html-table-header-cell/markup
markup . objects)): new func
* src/scm/report/taxtxf.scm: more work on porting
* src/scm/html-style-sheet.scm: add "<number-cell>" and
"<number-header>" styles.
* src/scm/report/account-summary.scm: use "Total" not "Net
Assets". This is a general report, not just limited to asset
accounts.
2001-03-10 Dave Peticolas <dave@krondo.com> 2001-03-10 Dave Peticolas <dave@krondo.com>
* src/engine/Ledger-xml-parser-v1.c * src/engine/Ledger-xml-parser-v1.c

10
src/scm/html-style-sheet.scm
View File

@ -156,6 +156,16 @@
rv "<gnc-monetary>" rv "<gnc-monetary>"
gnc:default-html-gnc-monetary-renderer #f) gnc:default-html-gnc-monetary-renderer #f)
(gnc:html-style-sheet-set-style!
rv "<number-cell>"
'tag "td"
'attribute (list "align" "right"))
(gnc:html-style-sheet-set-style!
rv "<number-header>"
'tag "th"
'attribute (list "align" "right"))
;; store it in the style sheet hash ;; store it in the style sheet hash
(hash-set! *gnc:_style-sheets_* style-sheet-name rv) (hash-set! *gnc:_style-sheets_* style-sheet-name rv)
rv) rv)

4
src/scm/html-table.scm
View File

@ -67,6 +67,10 @@
(gnc:make-html-table-cell-internal 1 1 "th" objects (gnc:make-html-table-cell-internal 1 1 "th" objects
(gnc:make-html-style-table))) (gnc:make-html-style-table)))
(define (gnc:make-html-table-header-cell/markup markup . objects)
(gnc:make-html-table-cell-internal 1 1 markup objects
(gnc:make-html-style-table)))
(define (gnc:make-html-table-header-cell/size rowspan colspan . objects) (define (gnc:make-html-table-header-cell/size rowspan colspan . objects)
(gnc:make-html-table-cell-internal rowspan colspan "th" (gnc:make-html-table-cell-internal rowspan colspan "th"
objects (gnc:make-html-style-table))) objects (gnc:make-html-style-table)))

2
src/scm/report/account-summary.scm
View File

@ -137,7 +137,7 @@
#f date-tp #f date-tp
tree-depth show-subaccts? accounts tree-depth show-subaccts? accounts
#t gnc:accounts-get-comm-total-assets #t gnc:accounts-get-comm-total-assets
(_ "Net Assets") do-grouping? do-subtotals? (_ "Total") do-grouping? do-subtotals?
show-fcur? report-currency exchange-fn))) show-fcur? report-currency exchange-fn)))
;; add the table ;; add the table

176
src/scm/report/taxtxf.scm
View File

@ -4,8 +4,6 @@
;; This prints Tax related accounts and exports TXF files for import to ;; This prints Tax related accounts and exports TXF files for import to
;; TaxCut, TurboTax, etc. ;; TaxCut, TurboTax, etc.
;; ;;
;; It also prints a Hierarchical Report for any account.
;;
;; For this to work, the user has to segregate taxable and not taxable ;; For this to work, the user has to segregate taxable and not taxable
;; income to different accounts, as well as deductible and non ;; income to different accounts, as well as deductible and non
;; deductible expenses. ;; deductible expenses.
@ -25,7 +23,7 @@
;; Optionally prints brief or full account names ;; Optionally prints brief or full account names
;; ;;
;; NOTE: setting of specific dates is squirly! and seems to be ;; NOTE: setting of specific dates is squirly! and seems to be
;; current-date dependabnt! Actually, time of day dependant! Just ;; current-date dependant! Actually, time of day dependant! Just
;; after midnight gives diffenent dates than just before! Referencing ;; after midnight gives diffenent dates than just before! Referencing
;; all times to noon seems to fix this. Subtracting 1 year sometimes ;; all times to noon seems to fix this. Subtracting 1 year sometimes
;; subtracts 2! see "(to-value" ;; subtracts 2! see "(to-value"
@ -48,7 +46,6 @@
;; Just a private scope. ;; Just a private scope.
(let* ((MAX-LEVELS 16) ; Maximum Account Levels (let* ((MAX-LEVELS 16) ; Maximum Account Levels
(levelx-collector (make-level-collector MAX-LEVELS)) (levelx-collector (make-level-collector MAX-LEVELS))
(bg-color "#f6ffdb")
(red "#ff0000") (red "#ff0000")
(white "#ffffff") (white "#ffffff")
(blue "#0000ff")) (blue "#0000ff"))
@ -158,15 +155,10 @@
(define tax-tab-title (N_ "TAX Report Options")) (define tax-tab-title (N_ "TAX Report Options"))
(define hierarchical-tab-title (N_ "Hierarchical Options"))
(define (tax-options-generator) (define (tax-options-generator)
(options-generator #f tax-tab-title)) (options-generator tax-tab-title))
(define (hierarchical-options-generator) (define (options-generator tab-title)
(options-generator #t hierarchical-tab-title))
(define (options-generator hierarchical? tab-title)
(define gnc:*tax-report-options* (gnc:new-options)) (define gnc:*tax-report-options* (gnc:new-options))
(define (gnc:register-tax-option new-option) (define (gnc:register-tax-option new-option)
(gnc:register-option gnc:*tax-report-options* new-option)) (gnc:register-option gnc:*tax-report-options* new-option))
@ -238,8 +230,6 @@
tab-title (N_ "Print Full account names") tab-title (N_ "Print Full account names")
"g" (N_ "Print all Parent account names") #f)) "g" (N_ "Print all Parent account names") #f))
(if (not hierarchical?)
(begin
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
tab-title (N_ "Set/Reset Tax Status") tab-title (N_ "Set/Reset Tax Status")
@ -303,7 +293,7 @@
(N_ "Use Current Account Name"))) (N_ "Use Current Account Name")))
(list->vector (list->vector
(list 'parent (N_ "^ Parent Account") (list 'parent (N_ "^ Parent Account")
(N_ "Use Parent Account Name")))))))) (N_ "Use Parent Account Name"))))))
gnc:*tax-report-options*) gnc:*tax-report-options*)
@ -654,15 +644,15 @@
;; Render any level ;; Render any level
(define (render-level-x-account level max-level account lx-value (define (render-level-x-account level max-level account lx-value
suppress-0 full-names txf-date hierarchical?) suppress-0 full-names txf-date)
(let* ((indent-1 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;") (let* ((indent-1 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;")
(account-name (if txf-date ; special split (account-name (if txf-date ; special split
(strftime "%Y-%b-%d" (localtime (car txf-date))) (strftime "%Y-%b-%d" (localtime (car txf-date)))
(if (or full-names (equal? level 1)) (if (or full-names (equal? level 1))
(gnc:account-get-full-name account) (gnc:account-get-full-name account)
(gnc:account-get-name account)))) (gnc:account-get-name account))))
(blue? (and (not hierarchical?) (gnc:account-get-txf account))) (blue? (gnc:account-get-txf account))
(color (if (= level 1) white bg-color)) (color white)
(print-info (gnc:account-value-print-info account #f)) (print-info (gnc:account-value-print-info account #f))
(value (gnc:amount->string lx-value print-info)) (value (gnc:amount->string lx-value print-info))
(value-formatted (if blue? (value-formatted (if blue?
@ -704,20 +694,17 @@
;; Recursivly validate children if parent is not a tax account. ;; Recursivly validate children if parent is not a tax account.
;; Don't check children if parent is valid. ;; Don't check children if parent is valid.
;; Returns the Parent if a child or grandchild is valid. ;; Returns the Parent if a child or grandchild is valid.
(define (validate accounts hierarchical?) (define (validate accounts)
(if hierarchical?
accounts
(apply append (map (lambda (a) (apply append (map (lambda (a)
(if (gnc:account-get-tax a) (if (gnc:account-get-tax a)
(list a) (list a)
;; check children ;; check children
(if (null? (validate (if (null? (validate
(gnc:group-ptr->list (gnc:group-ptr->list
(gnc:account-get-children a)) (gnc:account-get-children a))))
#f))
'() '()
(list a)))) (list a))))
accounts)))) accounts)))
;; Set or Reset key in account notes ;; Set or Reset key in account notes
(define (key-status accounts set key end-key kids) (define (key-status accounts set key end-key kids)
@ -768,9 +755,7 @@
(lambda (x) (num-generations x (+ 1 gen))) (lambda (x) (num-generations x (+ 1 gen)))
children))))) children)))))
(let* ((hierarchical? (equal? (_ "Hierarchical Accounts Report") (let* ((tab-title tax-tab-title)
report-name))
(tab-title (if hierarchical? hierarchical-tab-title tax-tab-title))
(from-value (gnc:date-option-absolute-time (from-value (gnc:date-option-absolute-time
(get-option tab-title "From"))) (get-option tab-title "From")))
(to-value (gnc:timepair-end-day-time (to-value (gnc:timepair-end-day-time
@ -783,13 +768,12 @@
(tax-mode tax-mode-in) ; these need to different later (tax-mode tax-mode-in) ; these need to different later
(user-sel-accnts (get-option tab-title (user-sel-accnts (get-option tab-title
"Select Accounts (none = all)")) "Select Accounts (none = all)"))
(valid-user-sel-accnts (validate user-sel-accnts hierarchical?)) (valid-user-sel-accnts (validate user-sel-accnts))
;; If no selected accounts, check all. ;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts)) (selected-accounts (if (not (null? user-sel-accnts))
valid-user-sel-accnts valid-user-sel-accnts
(validate (gnc:group-ptr->list (validate (gnc:group-ptr->list
(gnc:get-current-group)) (gnc:get-current-group)))))
hierarchical?)))
(generations (if (pair? selected-accounts) (generations (if (pair? selected-accounts)
(apply max (map (lambda (x) (num-generations x 1)) (apply max (map (lambda (x) (num-generations x 1))
selected-accounts)) selected-accounts))
@ -870,10 +854,8 @@
(set! bdtm (gnc:timepair->date to-value))))) (set! bdtm (gnc:timepair->date to-value)))))
(cons (car (mktime bdtm)) 0)))) (cons (car (mktime bdtm)) 0))))
(txf-help (txf-help (get-option "TXF Export Init"
(if hierarchical? #f "Print extended TXF HELP messages"))
(get-option "TXF Export Init"
"Print extended TXF HELP messages")))
(txf-feedback-str-lst '()) (txf-feedback-str-lst '())
(doc (gnc:make-html-document)) (doc (gnc:make-html-document))
(table (gnc:make-html-table))) (table (gnc:make-html-table)))
@ -935,10 +917,9 @@
(let ((type (gw:enum-GNCAccountType-val->sym (let ((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account) #f)) (gnc:account-get-type account) #f))
(name (gnc:account-get-name account))) (name (gnc:account-get-name account)))
(if (or hierarchical? (is-type-income-or-expense? type)) (if (is-type-income-or-expense? type)
(let* ((children (gnc:account-get-children account)) (let* ((children (gnc:account-get-children account))
(childrens-output (if (and (not children) (childrens-output (if (not children)
(not hierarchical?))
(handle-txf-special-splits (handle-txf-special-splits
level account from-value level account from-value
to-value) to-value)
@ -950,8 +931,7 @@
'())) '()))
children))) children)))
(account-balance (if (or hierarchical? (account-balance (if (gnc:account-get-tax account)
(gnc:account-get-tax account))
(d-gnc:account-get-balance-interval (d-gnc:account-get-balance-interval
account from-value to-value #f) account from-value to-value #f)
0))) ; don't add non tax related 0))) ; don't add non tax related
@ -969,8 +949,7 @@
(if tax-mode (if tax-mode
(render-level-x-account level max-level account (render-level-x-account level max-level account
account-balance account-balance
suppress-0 full-names #f suppress-0 full-names #f)
hierarchical?)
(render-txf-account account account-balance #f)))) (render-txf-account account account-balance #f))))
(if (equal? 1 level) (if (equal? 1 level)
(lx-collector 1 'reset #f)) (lx-collector 1 'reset #f))
@ -990,7 +969,6 @@
;; Ignore ;; Ignore
'()))) '())))
(if (not hierarchical?)
(let* ((tax-stat (get-option tab-title "Set/Reset Tax Status")) (let* ((tax-stat (get-option tab-title "Set/Reset Tax Status"))
(txf-acc-lst (get-option "TXF Export Init" "Select Account")) (txf-acc-lst (get-option "TXF Export Init" "Select Account"))
(txf-account (if (null? txf-acc-lst) (txf-account (if (null? txf-acc-lst)
@ -1025,10 +1003,9 @@
txf-payer-source)) txf-payer-source))
txf-acc-lst))) txf-acc-lst)))
(set! txf-feedback-str-lst (map txf-feedback-str txf-fun-str-lst (set! txf-feedback-str-lst (map txf-feedback-str txf-fun-str-lst
txf-full-name-lst)))) txf-full-name-lst)))
(let ((output '()) (let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(to-date (strftime "%Y-%b-%d" (localtime (car to-value)))) (to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
(today-date (strftime "D%m/%d/%Y" (today-date (strftime "D%m/%d/%Y"
(localtime (localtime
@ -1041,6 +1018,14 @@
report-name)) report-name))
(file-name #f)) (file-name #f))
(define (make-sub-headers max-level)
(if (eq? max-level 0)
'()
(cons (gnc:make-html-table-header-cell/markup
"<number-header>"
"(" (_ "Sub") " " (number->string max-level) ")")
(make-sub-headers (- max-level 1)))))
;; Now, the main body ;; Now, the main body
;; Reset all the balance collectors ;; Reset all the balance collectors
(do ((i 1 (+ i 1))) (do ((i 1 (+ i 1)))
@ -1063,7 +1048,7 @@
(if (gnc:verify-dialog (if (gnc:verify-dialog
(string-append (string-append
"File: \"" fname "File: \"" fname
"\" exists, Over Write?") "\" exists, Overwrite?")
#f) #f)
(begin (delete-file fname) (begin (delete-file fname)
#t) #t)
@ -1091,24 +1076,19 @@
(close-output-port port))))) (close-output-port port)))))
(set! tax-mode #t) ; now do tax mode to display report (set! tax-mode #t) ; now do tax mode to display report
(set! output (list ; (set! output (list
(if txf-help ; (if txf-help
(append (map (lambda (x) (txf-print-help x #t)) ; (append (map (lambda (x) (txf-print-help x #t))
txf-help-catagories) ; txf-help-catagories)
(map (lambda (x) (txf-print-help x #t)) ; (map (lambda (x) (txf-print-help x #t))
txf-income-catagories) ; txf-income-catagories)
(map (lambda (x) (txf-print-help x #f)) ; (map (lambda (x) (txf-print-help x #f))
txf-expense-catagories)) ; txf-expense-catagories))
(map (lambda (x) (handle-level-x-account 1 x)) ; (map (lambda (x) (handle-level-x-account 1 x))
selected-accounts)))) ; selected-accounts))))
(gnc:html-document-set-title! doc report-title) (gnc:html-document-set-title! doc report-title)
(gnc:html-document-set-style!
doc "body"
'attribute (list "bgcolor" bg-color)
'tag "center")
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc doc
(gnc:make-html-text (gnc:make-html-text
@ -1117,10 +1097,9 @@
(_ "Period from %s to %s") from-date to-date)))) (_ "Period from %s to %s") from-date to-date))))
(let ((text (gnc:make-html-text))) (let ((text (gnc:make-html-text)))
(gnc:html-text-set-style! text 'font-color "#0000ff") (gnc:html-text-set-style! text "p" 'font-color blue)
(gnc:html-document-add-object! doc text) (gnc:html-document-add-object! doc text)
(if (not hierarchical?)
(if tax-mode-in (if tax-mode-in
(if (not txf-help) (if (not txf-help)
(gnc:html-text-append! (gnc:html-text-append!
@ -1135,9 +1114,9 @@
(_ "Blue items were exported to file %s.") (_ "Blue items were exported to file %s.")
(gnc:html-markup-tt file-name)) (gnc:html-markup-tt file-name))
(_ "Blue items were <em>not</em> exported to \ (_ "Blue items were <em>not</em> exported to \
txf file!")))))) txf file!")))))
(if (not (or hierarchical? txf-help)) (if (not txf-help)
(map (lambda (s) (map (lambda (s)
(gnc:html-text-append! text (gnc:html-markup-p s))) (gnc:html-text-append! text (gnc:html-markup-p s)))
txf-feedback-str-lst))) txf-feedback-str-lst)))
@ -1164,35 +1143,26 @@ txf file!"))))))
(html-red "Expense")))) (html-red "Expense"))))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table table
(append
(list (list
(gnc:make-html-table-header-cell (gnc:make-html-table-header-cell
(_ "Account Name"))))) (_ "Account Name")))
(make-sub-headers max-level)
(list
(gnc:make-html-table-header-cell/markup
"<number-header>" (_ "Total"))))))
(if (null? selected-accounts)
#f)
(list (list
(if txf-help (if (null? selected-accounts)
""
(do ((i (- max-level 1) (- i 1))
(head "" (string-append
head "<th align=right>" (_ "(Sub ")
(number->string i) ")</th>")))
((< i 1) head)))
(if txf-help
(list "<th>" (_ "Extended TXF Help messages")
(html-blue " Income") (html-red " Expense"))
(list "<th align=right>" (_ "Total")))
output
"</table>\n"
(if (null? (car output))
(string-append (string-append
"<p><b>" "<p><b>"
(if hierarchical?
(_ "No accounts were found.")
(_ "No Tax Related accounts were found. Click \ (_ "No Tax Related accounts were found. Click \
\"Parameters\" to set some with the \"Set/Reset Tax Status:\" parameter.")) \"Parameters\" to set some with the \"Set/Reset Tax Status:\" parameter.")
"</b></p>\n") "</b></p>\n")
" ") " "))
"</body>"
"</html>")
doc))) doc)))
;; copy help strings to category structures. ;; copy help strings to category structures.
@ -1200,18 +1170,6 @@ txf file!"))))))
(txf-help txf-expense-catagories) (txf-help txf-expense-catagories)
(txf-help txf-help-catagories) (txf-help txf-help-catagories)
; (gnc:define-report
; 'version 1
; 'name (N_ "Hierarchical")
; 'options-generator hierarchical-options-generator
; 'renderer (lambda (report-obj)
; (generate-tax-or-txf
; (_ "Hierarchical Accounts Report")
; (_ "This page shows your Taxable Income and \
;Deductable Expenses.")
; report-obj
; #t)))
(gnc:define-report (gnc:define-report
'version 1 'version 1
'name (N_ "Tax") 'name (N_ "Tax")
@ -1222,16 +1180,16 @@ txf file!"))))))
(_ "This page shows your Taxable Income and \ (_ "This page shows your Taxable Income and \
Deductable Expenses.") Deductable Expenses.")
report-obj report-obj
#t))) #t))))
(gnc:define-report ; (gnc:define-report
'version 1 ; 'version 1
'name (N_ "Export .TXF") ; 'name (N_ "Export .TXF")
'options-generator tax-options-generator ; 'options-generator tax-options-generator
'renderer (lambda (report-obj) ; 'renderer (lambda (report-obj)
(generate-tax-or-txf ; (generate-tax-or-txf
(_ "Taxable Income / Deductible Expenses") ; (_ "Taxable Income / Deductible Expenses")
(_ "This page shows your Taxable Income and \ ; (_ "This page shows your Taxable Income and \
Deductable Expenses.") ;Deductable Expenses.")
report-obj ; report-obj
#f)))) ; #f))))