1;; -*-scheme-*- 2;; invoice.scm -- an Invoice Report, used to print a GncInvoice 3;; 4;; Created by: Derek Atkins <warlord@MIT.EDU> 5;; Copyright (c) 2002, 2003 Derek Atkins <warlord@MIT.EDU> 6;; 7;; This program is free software; you can redistribute it and/or 8;; modify it under the terms of the GNU General Public License as 9;; published by the Free Software Foundation; either version 2 of 10;; the License, or (at your option) any later version. 11;; 12;; This program is distributed in the hope that it will be useful, 13;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16;; 17;; You should have received a copy of the GNU General Public License 18;; along with this program; if not, contact: 19;; 20;; Free Software Foundation Voice: +1-617-542-5942 21;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 22;; Boston, MA 02110-1301, USA gnu@gnu.org 23 24 25(define-module (gnucash reports standard invoice)) 26 27(use-modules (gnucash engine)) 28(use-modules (gnucash core-utils)) 29(use-modules (gnucash utilities)) 30(use-modules (gnucash app-utils)) 31(use-modules (gnucash report)) 32(use-modules (srfi srfi-1)) 33 34(define (addif pred . data) (if pred data '())) 35 36(define base-css "/* advanced users only */ 37.div-align-right { float: right; } 38.div-align-right .maybe-align-right { text-align: right } 39.entries-table * { border-width: 1px; border-style:solid; border-collapse: collapse} 40.entries-table > table { width: 100% } 41.company-table > table * { padding: 0px; } 42.client-table > table * { padding: 0px; } 43.invoice-details-table > table * { padding: 0px; } 44@media print { .main-table > table { width: 100%; }} 45") 46 47(define (date-col columns-used) 48 (vector-ref columns-used 0)) 49(define (description-col columns-used) 50 (vector-ref columns-used 1)) 51(define (action-col columns-used) 52 (vector-ref columns-used 2)) 53(define (quantity-col columns-used) 54 (vector-ref columns-used 3)) 55(define (price-col columns-used) 56 (vector-ref columns-used 4)) 57(define (discount-col columns-used) 58 (vector-ref columns-used 5)) 59(define (tax-col columns-used) 60 (vector-ref columns-used 6)) 61(define (taxvalue-col columns-used) 62 (vector-ref columns-used 7)) 63(define (value-col columns-used) 64 (vector-ref columns-used 8)) 65 66(define (num-columns-required columns-used) 67 ;; count number of columns where (vector-ref columns-used col) is #t 68 (count identity (vector->list columns-used))) 69 70(define (build-column-used options) 71 (define (opt-val section name) 72 (gnc:option-value 73 (gnc:lookup-option options section name))) 74 (vector 75 (opt-val "Display Columns" "Date") 76 (opt-val "Display Columns" "Description") 77 (opt-val "Display Columns" "Action") 78 (opt-val "Display Columns" "Quantity") 79 (opt-val "Display Columns" "Price") 80 (opt-val "Display Columns" "Discount") 81 (opt-val "Display Columns" "Taxable") 82 (opt-val "Display Columns" "Tax Amount") 83 (opt-val "Display Columns" "Total"))) 84 85(define (make-heading-list column-vector) 86 (append 87 (addif (date-col column-vector) 88 (G_ "Date")) 89 (addif (description-col column-vector) 90 (G_ "Description")) 91 (addif (action-col column-vector) 92 (G_ "Action")) 93 (addif (quantity-col column-vector) 94 (G_ "Quantity")) 95 (addif (price-col column-vector) 96 (G_ "Unit Price")) 97 (addif (discount-col column-vector) 98 (G_ "Discount")) 99 (addif (tax-col column-vector) 100 (G_ "Taxable")) 101 (addif (taxvalue-col column-vector) 102 (G_ "Tax Amount")) 103 (addif (value-col column-vector) 104 (G_ "Total")))) 105 106(define (monetary-or-percent numeric currency entry-type) 107 (if (eqv? entry-type GNC-AMT-TYPE-PERCENT) 108 (string-append (gnc:default-html-gnc-numeric-renderer numeric #f) " " (G_ "%")) 109 (gnc:make-gnc-monetary currency numeric))) 110 111(define layout-key-list 112 (list (cons 'client (list (cons 'text (G_ "Client or vendor name, address and ID")))) 113 (cons 'company (list (cons 'text (G_ "Company name, address and tax-ID")))) 114 (cons 'invoice (list (cons 'text (G_ "Invoice date, due date, billing ID, terms, job details")))) 115 (cons 'today (list (cons 'text (G_ "Today's date")))) 116 (cons 'picture (list (cons 'text (G_ "Picture")))) 117 118 ;; Translators: "Empty space" refers to invoice header section being left blank 119 (cons 'none (list (cons 'text (G_ "Empty space")))))) 120 121(define variant-list 122 (list 123 (cons 'invoice (list (cons '1a 'none) 124 (cons '1b 'invoice) 125 (cons '2a 'client) 126 (cons '2b 'company) 127 (cons '3a 'none) 128 (cons '3b 'today) 129 (cons 'css base-css))) 130 131 (cons 'easy-invoice (list (cons '1a 'none) 132 (cons '1b 'invoice) 133 (cons '2a 'client) 134 (cons '2b 'company) 135 (cons '3a 'none) 136 (cons '3b 'today) 137 (cons 'css (string-append base-css " 138.invoice-in-progress { color:red } 139.invoice-title { font-weight: bold; text-decoration: underline } 140.main-table > table { margin: auto } 141.invoice-details-table > table { display: block; } 142.invoice-notes { margin-top: 20px } 143.entries-table > table { min-width: 600px }")))) 144 145 (cons 'fancy-invoice (list (cons '1a 'company) 146 (cons '1b 'invoice) 147 (cons '2a 'client) 148 (cons '2b 'company) 149 (cons '3a 'none) 150 (cons '3b 'none) 151 (cons 'css (string-append base-css " 152.company-name {font-size: x-large; } 153.client-name {font-size: x-large; }")))))) 154 155(define (keylist-get-info keylist key info) 156 (cdr (assq info (cdr (assq key keylist))))) 157 158(define (keylist->vectorlist keylist) 159 (map 160 (lambda (item) 161 (vector 162 (car item) 163 (keylist-get-info keylist (car item) 'text))) 164 keylist)) 165 166(define (multiline-to-html-text str) 167 (gnc:multiline-to-html-text str)) 168 169(define (options-generator variant) 170 171 (define gnc:*report-options* (gnc:new-options)) 172 173 (define (gnc:register-inv-option new-option) 174 (gnc:register-option gnc:*report-options* new-option)) 175 176 (gnc:register-inv-option 177 (gnc:make-invoice-option gnc:pagename-general gnc:optname-invoice-number "x" "" 178 (lambda () '()) #f)) 179 180 (gnc:register-inv-option 181 (gnc:make-string-option 182 gnc:pagename-general (N_ "Custom Title") 183 "z" (N_ "A custom string to replace Invoice, Bill or Expense Voucher.") 184 "")) 185 186 (gnc:register-inv-option 187 (gnc:make-text-option 188 (N_ "Layout") (N_ "CSS") "zz" (N_ "CSS code. This field specifies the CSS code \ 189for styling the invoice. Please see the exported report for the CSS class names.") 190 (keylist-get-info variant-list variant 'css))) 191 192 (gnc:register-inv-option 193 (gnc:make-pixmap-option 194 (N_ "Layout") (N_ "Picture Location") "zy" (N_ "Location for Picture") 195 "")) 196 197 (gnc:register-inv-option 198 (gnc:make-simple-boolean-option 199 (N_ "Display Columns") (N_ "Date") 200 "b" (N_ "Display the date?") #t)) 201 202 (gnc:register-inv-option 203 (gnc:make-simple-boolean-option 204 (N_ "Display Columns") (N_ "Description") 205 "d" (N_ "Display the description?") #t)) 206 207 (gnc:register-inv-option 208 (gnc:make-simple-boolean-option 209 (N_ "Display Columns") (N_ "Action") 210 "g" (N_ "Display the action?") #t)) 211 212 (gnc:register-inv-option 213 (gnc:make-simple-boolean-option 214 (N_ "Display Columns") (N_ "Quantity") 215 "ha" (N_ "Display the quantity of items?") #t)) 216 217 (gnc:register-inv-option 218 (gnc:make-simple-boolean-option 219 (N_ "Display Columns") (N_ "Price") 220 "hb" (N_ "Display the price per item?") #t)) 221 222 (gnc:register-inv-option 223 (gnc:make-simple-boolean-option 224 (N_ "Display Columns") (N_ "Discount") 225 "k" (N_ "Display the entry's discount?") #t)) 226 227 (gnc:register-inv-option 228 (gnc:make-simple-boolean-option 229 (N_ "Display Columns") (N_ "Taxable") 230 "l" (N_ "Display the entry's taxable status?") #t)) 231 232 (gnc:register-inv-option 233 (gnc:make-simple-boolean-option 234 (N_ "Display Columns") (N_ "Tax Amount") 235 "m" (N_ "Display each entry's total total tax?") #f)) 236 237 (gnc:register-inv-option 238 (gnc:make-simple-boolean-option 239 (N_ "Display Columns") (N_ "Total") 240 "n" (N_ "Display the entry's value?") #t)) 241 242 (gnc:register-inv-option 243 (gnc:make-simple-boolean-option 244 (N_ "Display") (N_ "Due Date") 245 "c" (N_ "Display due date?") #t)) 246 247 (gnc:register-inv-option 248 (gnc:make-simple-boolean-option 249 (N_ "Display") (N_ "Subtotal") 250 "d" (N_ "Display the subtotals?") #t)) 251 252 (gnc:register-inv-option 253 (gnc:make-complex-boolean-option 254 (N_ "Display") (N_ "Payable to") 255 "ua1" (N_ "Display the Payable to: information.") #f #f 256 (lambda (x) 257 (gnc-option-db-set-option-selectable-by-name 258 gnc:*report-options* "Display" "Payable to string" x)))) 259 260 (gnc:register-inv-option 261 (gnc:make-text-option 262 (N_ "Display") (N_ "Payable to string") 263 "ua2" (N_ "The phrase for specifying to whom payments should be made.") 264 (G_ "Please make all checks payable to"))) 265 266 (gnc:register-inv-option 267 (gnc:make-complex-boolean-option 268 (N_ "Display") (N_ "Company contact") 269 "ub1" (N_ "Display the Company contact information.") #f #f 270 (lambda (x) (gnc-option-db-set-option-selectable-by-name 271 gnc:*report-options* "Display" "Company contact string" x)))) 272 273 (gnc:register-inv-option 274 (gnc:make-text-option 275 (N_ "Display") (N_ "Company contact string") 276 "ub2" (N_ "The phrase used to introduce the company contact.") 277 (G_ "Please direct all enquiries to"))) 278 279 (gnc:register-inv-option 280 (gnc:make-number-range-option 281 (N_ "Display") (N_ "Minimum # of entries") 282 "zz" (N_ "The minimum number of invoice entries to display.") 1 283 0 23 0 1)) 284 285 (gnc:register-inv-option 286 (gnc:make-simple-boolean-option 287 (N_ "Display") (N_ "Use Detailed Tax Summary") 288 "o" (N_ "Display all tax categories separately (one per line) instead of one single tax line.?") #f)) 289 290 (gnc:register-inv-option 291 (gnc:make-simple-boolean-option 292 (N_ "Display") (N_ "References") 293 "s" (N_ "Display the invoice references?") #t)) 294 295 (gnc:register-inv-option 296 (gnc:make-simple-boolean-option 297 (N_ "Display") (N_ "Billing Terms") 298 "t" (N_ "Display the invoice billing terms?") #t)) 299 300 (gnc:register-inv-option 301 (gnc:make-simple-boolean-option 302 (N_ "Display") (N_ "Billing ID") 303 "ta" (N_ "Display the billing id?") #t)) 304 305 (gnc:register-inv-option 306 (gnc:make-simple-boolean-option 307 (N_ "Display") (N_ "Invoice owner ID") 308 "tam" (N_ "Display the customer/vendor id?") #f)) 309 310 (gnc:register-inv-option 311 (gnc:make-simple-boolean-option 312 (N_ "Display") (N_ "Invoice Notes") 313 "tb" (N_ "Display the invoice notes?") #f)) 314 315 (gnc:register-inv-option 316 (gnc:make-simple-boolean-option 317 (N_ "Display") (N_ "Payments") 318 "tc" (N_ "Display the payments applied to this invoice?") #t)) 319 320 (gnc:register-inv-option 321 (gnc:make-simple-boolean-option 322 (N_ "Display") (N_ "Job Details") 323 "td" (N_ "Display the job name for this invoice?") #f)) 324 325 (gnc:register-inv-option 326 (gnc:make-text-option 327 (N_ "Display") (N_ "Extra Notes") 328 "u" (N_ "Extra notes to put on the invoice.") 329 (G_ "Thank you for your patronage!"))) 330 331 (gnc:register-inv-option 332 (gnc:make-multichoice-option 333 (N_ "Layout") (N_ "Row 1 Left") 334 "1a" "1st row, left" 335 (keylist-get-info variant-list variant '1a) 336 (keylist->vectorlist layout-key-list))) 337 338 (gnc:register-inv-option 339 (gnc:make-multichoice-option 340 (N_ "Layout") (N_ "Row 1 Right") 341 "1b" "1st row, right" 342 (keylist-get-info variant-list variant '1b) 343 (keylist->vectorlist layout-key-list))) 344 345 (gnc:register-inv-option 346 (gnc:make-multichoice-option 347 (N_ "Layout") (N_ "Row 2 Left") 348 "2a" "2nd row, left" 349 (keylist-get-info variant-list variant '2a) 350 (keylist->vectorlist layout-key-list))) 351 352 (gnc:register-inv-option 353 (gnc:make-multichoice-option 354 (N_ "Layout") (N_ "Row 2 Right") 355 "2b" "2nd row, right" 356 (keylist-get-info variant-list variant '2b) 357 (keylist->vectorlist layout-key-list))) 358 359 (gnc:register-inv-option 360 (gnc:make-multichoice-option 361 (N_ "Layout") (N_ "Row 3 Left") 362 "3a" "3rd row, left" 363 (keylist-get-info variant-list variant '3a) 364 (keylist->vectorlist layout-key-list))) 365 366 (gnc:register-inv-option 367 (gnc:make-multichoice-option 368 (N_ "Layout") (N_ "Row 3 Right") 369 "3b" "3rd row, right" 370 (keylist-get-info variant-list variant '3b) 371 (keylist->vectorlist layout-key-list))) 372 373 (gnc:options-set-default-section gnc:*report-options* "General") 374 375 gnc:*report-options*) 376 377 378(define (make-entry-table invoice options cust-doc? credit-note?) 379 (define (opt-val section name) 380 (gnc:option-value 381 (gnc:lookup-option options section name))) 382 383 (let ((show-payments (opt-val "Display" "Payments")) 384 (display-all-taxes (opt-val "Display" "Use Detailed Tax Summary")) 385 (display-subtotal? (opt-val "Display" "Subtotal")) 386 (lot (gncInvoiceGetPostedLot invoice)) 387 (txn (gncInvoiceGetPostedTxn invoice)) 388 (currency (gncInvoiceGetCurrency invoice)) 389 (reverse-payments? (not (gncInvoiceAmountPositive invoice)))) 390 391 (define (display-subtotal monetary used-columns) 392 (if (value-col used-columns) 393 monetary 394 (let ((amt (gnc:gnc-monetary-amount monetary))) 395 (if amt 396 (if (negative? amt) 397 (gnc:monetary-neg monetary) 398 monetary) 399 monetary)))) 400 401 (define (add-payment-row table used-columns split total-collector reverse-payments?) 402 (let* ((t (xaccSplitGetParent split)) 403 (currency (xaccTransGetCurrency t)) 404 ;; Depending on the document type, the payments may need to be sign-reversed 405 (amt (gnc:make-gnc-monetary currency 406 (if reverse-payments? 407 (- (xaccSplitGetValue split)) 408 (xaccSplitGetValue split))))) 409 410 (total-collector 'add 411 (gnc:gnc-monetary-commodity amt) 412 (gnc:gnc-monetary-amount amt)) 413 414 (gnc:html-table-append-row/markup! 415 table "grand-total" 416 (append 417 (addif (date-col used-columns) 418 (qof-print-date (xaccTransGetDate t))) 419 420 (addif (description-col used-columns) 421 (G_ "Payment, thank you!")) 422 423 (list (gnc:make-html-table-cell/size/markup 424 1 (- (max 3 (num-columns-required used-columns)) 425 (if (date-col used-columns) 1 0) 426 (if (description-col used-columns) 1 0)) 427 "total-number-cell" 428 (display-subtotal amt used-columns))))))) 429 430 (let* ((table (gnc:make-html-table)) 431 (used-columns (build-column-used options)) 432 (entries (gncInvoiceGetEntries invoice))) 433 434 (define (add-entry-row entry row-style) 435 (gnc:html-table-append-row/markup! 436 table row-style 437 (append 438 (addif (date-col used-columns) 439 (qof-print-date (gncEntryGetDate entry))) 440 441 (addif (description-col used-columns) 442 (gncEntryGetDescription entry)) 443 444 (addif (action-col used-columns) 445 (gncEntryGetAction entry)) 446 447 (addif (quantity-col used-columns) 448 (gnc:make-html-table-cell/markup 449 "number-cell" 450 (gncEntryGetDocQuantity entry credit-note?))) 451 452 (addif (price-col used-columns) 453 (gnc:make-html-table-cell/markup 454 "number-cell" 455 (gnc:make-gnc-monetary 456 currency (if cust-doc? 457 (gncEntryGetInvPrice entry) 458 (gncEntryGetBillPrice entry))))) 459 460 (addif (discount-col used-columns) 461 (if cust-doc? 462 (gnc:make-html-table-cell/markup 463 "number-cell" 464 (monetary-or-percent (gncEntryGetInvDiscount entry) 465 currency 466 (gncEntryGetInvDiscountType entry))) 467 "")) 468 469 (addif (tax-col used-columns) 470 (if (if cust-doc? 471 (and (gncEntryGetInvTaxable entry) 472 (gncEntryGetInvTaxTable entry)) 473 (and (gncEntryGetBillTaxable entry) 474 (gncEntryGetBillTaxTable entry))) 475 ;; Translators: This "T" is displayed in the taxable column, if this entry contains tax 476 (G_ "T") "")) 477 478 (addif (taxvalue-col used-columns) 479 (gnc:make-html-table-cell/markup 480 "number-cell" 481 (gnc:make-gnc-monetary 482 currency (gncEntryGetDocTaxValue entry #t cust-doc? credit-note?)))) 483 484 (addif (value-col used-columns) 485 (gnc:make-html-table-cell/markup 486 "number-cell" 487 (gnc:make-gnc-monetary 488 currency (gncEntryGetDocValue entry #t cust-doc? credit-note?))))))) 489 490 (define (add-subtotal-row subtotal subtotal-style subtotal-label) 491 (gnc:html-table-append-row/markup! 492 table subtotal-style 493 (list (gnc:make-html-table-cell/markup 494 "total-label-cell" subtotal-label) 495 (gnc:make-html-table-cell/size/markup 496 1 (max 3 (num-columns-required used-columns)) 497 "total-number-cell" 498 (display-subtotal (gnc:make-gnc-monetary currency subtotal) used-columns))))) 499 500 (gnc:html-table-set-col-headers! table 501 (make-heading-list used-columns)) 502 503 (let do-rows-with-subtotals ((entries entries) 504 (odd-row? #t) 505 (num-entries 0)) 506 (if (null? entries) 507 508 ;; all entries done, add subtotals 509 (let ((total-collector (gnc:make-commodity-collector))) 510 511 ;; minimum number of entries- replicating fancy-invoice option 512 (let loop ((num-entries-left (- (opt-val "Display" "Minimum # of entries" ) num-entries)) 513 (odd-row? odd-row?)) 514 (when (positive? num-entries-left) 515 (gnc:html-table-append-row/markup! 516 table (if odd-row? "normal-row" "alternate-row") 517 (gnc:html-make-empty-cells (num-columns-required used-columns))) 518 (loop (1- num-entries-left) 519 (not odd-row?)))) 520 521 (if display-subtotal? 522 (add-subtotal-row (gncInvoiceGetTotalSubtotal invoice) 523 "grand-total" (G_ "Net Price"))) 524 525 (if display-all-taxes 526 (for-each 527 (lambda (parm) 528 (let ((value (cdr parm)) 529 (acct (car parm))) 530 (add-subtotal-row value 531 "grand-total" (xaccAccountGetName acct)))) 532 (gncInvoiceGetTotalTaxList invoice)) 533 534 ;; nope, just show the total tax. 535 (add-subtotal-row (gncInvoiceGetTotalTax invoice) 536 "grand-total" (G_ "Tax"))) 537 538 (add-subtotal-row (gncInvoiceGetTotal invoice) 539 "grand-total" (G_ "Total Price")) 540 541 (total-collector 'add currency (gncInvoiceGetTotal invoice)) 542 543 (if (and show-payments (not (null? lot))) 544 (let ((splits (sort-list! 545 (gnc-lot-get-split-list lot) 546 (lambda (s1 s2) 547 (let ((t1 (xaccSplitGetParent s1)) 548 (t2 (xaccSplitGetParent s2))) 549 (< (xaccTransOrder t1 t2) 0)))))) 550 (for-each 551 (lambda (split) 552 (if (not (equal? (xaccSplitGetParent split) txn)) 553 (add-payment-row table used-columns 554 split total-collector 555 reverse-payments?))) 556 splits))) 557 558 (add-subtotal-row (cadr (total-collector 'getpair currency #f)) 559 "grand-total" (G_ "Amount Due"))) 560 561 (begin 562 563 (add-entry-row (car entries) 564 (if odd-row? "normal-row" "alternate-row")) 565 566 (do-rows-with-subtotals (cdr entries) 567 (not odd-row?) 568 (1+ num-entries))))) 569 570 table))) 571 572(define (make-invoice-details-table invoice options) 573 ;; dual-column. invoice date/due, billingID, terms, job name/number 574 (define (opt-val section name) 575 (gnc:option-value 576 (gnc:lookup-option options section name))) 577 (let* ((invoice-details-table (gnc:make-html-table)) 578 (book (gncInvoiceGetBook invoice)) 579 (date-format (gnc:options-fancy-date book)) 580 (jobnumber (gncJobGetID (gncOwnerGetJob (gncInvoiceGetOwner invoice)))) 581 (jobname (gncJobGetName (gncOwnerGetJob (gncInvoiceGetOwner invoice))))) 582 583 (if (gncInvoiceIsPosted invoice) 584 585 (begin 586 (gnc:html-table-append-row! 587 invoice-details-table 588 (make-date-row (G_ "Date") (gncInvoiceGetDatePosted invoice) date-format)) 589 590 (if (opt-val "Display" "Due Date") 591 (gnc:html-table-append-row! 592 invoice-details-table 593 (make-date-row (G_ "Due Date") (gncInvoiceGetDateDue invoice) date-format)))) 594 595 (gnc:html-table-append-row! invoice-details-table 596 (gnc:make-html-table-cell/size 597 1 2 (gnc:make-html-span/markup 598 "invoice-in-progress" 599 (gnc:make-html-text 600 (G_ "Invoice in progress...")))))) 601 602 (if (opt-val "Display" "Billing ID") 603 (let ((billing-id (gncInvoiceGetBillingID invoice))) 604 (if (and billing-id (not (string-null? billing-id))) 605 (begin 606 (gnc:html-table-append-row! invoice-details-table 607 (list 608 (G_ "Reference:") 609 (gnc:make-html-div/markup 610 "div-align-right" 611 (multiline-to-html-text billing-id)))) 612 (gnc:html-table-append-row! invoice-details-table '()))))) 613 614 (if (opt-val "Display" "Billing Terms") 615 (let* ((term (gncInvoiceGetTerms invoice)) 616 (terms (gncBillTermGetDescription term))) 617 (if (and terms (not (string-null? terms))) 618 (gnc:html-table-append-row! invoice-details-table 619 (list 620 (G_ "Terms:") 621 (gnc:make-html-div/markup 622 "div-align-right" 623 (multiline-to-html-text terms))))))) 624 625 ;; Add job number and name to invoice if requested and if it exists 626 (if (and (opt-val "Display" "Job Details") 627 (not (string-null? jobnumber))) 628 (begin 629 (gnc:html-table-append-row! invoice-details-table 630 (list (G_ "Job number:") 631 (gnc:make-html-div/markup 632 "div-align-right" 633 jobnumber))) 634 (gnc:html-table-append-row! invoice-details-table 635 (list (G_ "Job name:") 636 (gnc:make-html-div/markup 637 "div-align-right" 638 jobname))))) 639 invoice-details-table)) 640 641(define (make-img img-url) 642 ;; just an image 643 (gnc:make-html-text 644 (gnc:html-markup-img 645 (make-file-url img-url)))) 646 647(define (make-client-table owner orders options) 648 (define (opt-val section name) 649 (gnc:option-value 650 (gnc:lookup-option options section name))) 651 ;; this is a single-column table. 652 (let ((table (gnc:make-html-table))) 653 654 (gnc:html-table-append-row! table 655 (list 656 (gnc:make-html-div/markup 657 "maybe-align-right client-name" 658 (gnc:owner-get-name-dep owner)))) 659 660 (gnc:html-table-append-row! table 661 (list 662 (gnc:make-html-div/markup 663 "maybe-align-right client-address" 664 (multiline-to-html-text 665 (gnc:owner-get-address-dep owner))))) 666 667 (if (opt-val "Display" "Invoice owner ID") 668 (gnc:html-table-append-row! table 669 (list 670 (gnc:make-html-div/markup 671 "maybe-align-right client-id" 672 (multiline-to-html-text 673 (gnc:owner-get-owner-id owner)))))) 674 675 (for-each 676 (lambda (order) 677 (let ((reference (gncOrderGetReference order))) 678 (if (and reference (not (string-null? reference))) 679 (gnc:html-table-append-row! table 680 (list (string-append 681 (G_ "REF") " " 682 reference)))))) 683 orders) 684 685 table)) 686 687(define (make-date-row label date date-format) 688 (list 689 (string-append label ":") 690 (gnc:make-html-div/markup 691 "div-align-right" 692 (gnc-print-time64 date date-format)))) 693 694(define (make-company-table book) 695 ;; single-column table. my name, address, and printdate 696 (let* ((table (gnc:make-html-table)) 697 (name (gnc:company-info book gnc:*company-name*)) 698 (addy (gnc:company-info book gnc:*company-addy*)) 699 (phone (gnc:company-info book gnc:*company-phone*)) 700 (fax (gnc:company-info book gnc:*company-fax*)) 701 (email (gnc:company-info book gnc:*company-email*)) 702 (url (gnc:company-info book gnc:*company-url*)) 703 (taxnr (gnc:option-get-value book gnc:*tax-label* gnc:*tax-nr-label*)) 704 (taxid (gnc:company-info book gnc:*company-id*))) 705 706 (if (and name (not (string-null? name))) 707 (gnc:html-table-append-row! table (list 708 (gnc:make-html-div/markup 709 "maybe-align-right company-name" name)))) 710 711 (if (and addy (not (string-null? addy))) 712 (gnc:html-table-append-row! table (list 713 (gnc:make-html-div/markup 714 "maybe-align-right company-address" (multiline-to-html-text addy))))) 715 716 (if (and phone (not (string-null? phone))) 717 (gnc:html-table-append-row! table (list 718 (gnc:make-html-div/markup 719 "maybe-align-right company-phone" phone)))) 720 721 (if (and fax (not (string-null? fax))) 722 (gnc:html-table-append-row! table (list 723 (gnc:make-html-div/markup 724 "maybe-align-right company-fax" fax)))) 725 726 (if (and email (not (string-null? email))) 727 (gnc:html-table-append-row! table (list 728 (gnc:make-html-div/markup 729 "maybe-align-right company-email" email)))) 730 731 (if (and url (not (string-null? url))) 732 (gnc:html-table-append-row! table (list 733 (gnc:make-html-div/markup 734 "maybe-align-right company-url" url)))) 735 736 (if (and taxid (not (string-null? taxid))) 737 (gnc:html-table-append-row! table (list 738 (gnc:make-html-div/markup 739 "maybe-align-right company-tax-id" taxid)))) 740 741 (if (and taxnr (not (string-null? taxnr))) 742 (gnc:html-table-append-row! 743 table (list (gnc:make-html-div/markup 744 "maybe-align-right company-tax-nr" taxnr)))) 745 746 table)) 747 748(define (reg-renderer report-obj) 749 (let* ((document (gnc:make-html-document)) 750 (options (gnc:report-options report-obj)) 751 (opt-val (lambda (section name) (gnc:option-value (gnc:lookup-option options section name)))) 752 (invoice (opt-val gnc:pagename-general gnc:optname-invoice-number)) 753 (references? (opt-val "Display" "References")) 754 (custom-title (opt-val gnc:pagename-general "Custom Title"))) 755 756 (if (null? invoice) 757 758 (gnc:html-document-add-object! 759 document 760 (gnc:html-make-generic-warning 761 (G_ "Invoice") (gnc:report-id report-obj) "" 762 (G_ "No valid invoice selected. Click on the Options button and select the invoice to use."))) 763 764 (let* ((book (gncInvoiceGetBook invoice)) 765 (owner (gncInvoiceGetOwner invoice)) 766 (type (gncInvoiceGetType invoice)) 767 (orders (if references? (delete-duplicates (map gncEntryGetOrder (gncInvoiceGetEntries invoice))) '())) 768 (cust-doc? (memv type (list GNC-INVOICE-CUST-INVOICE GNC-INVOICE-CUST-CREDIT-NOTE))) 769 (credit-note? (memv type (list GNC-INVOICE-CUST-CREDIT-NOTE GNC-INVOICE-VEND-CREDIT-NOTE GNC-INVOICE-EMPL-CREDIT-NOTE))) 770 (default-title (cond 771 ((eqv? type GNC-INVOICE-VEND-INVOICE) 772 (G_ "Bill")) 773 ((eqv? type GNC-INVOICE-EMPL-INVOICE) 774 (G_ "Expense Voucher")) 775 ((memv type (list GNC-INVOICE-CUST-CREDIT-NOTE 776 GNC-INVOICE-VEND-CREDIT-NOTE 777 GNC-INVOICE-EMPL-CREDIT-NOTE)) 778 (G_ "Credit Note")) 779 (else 780 (G_ "Invoice")))) 781 (title (if (string-null? custom-title) default-title custom-title)) 782 ;; Translators: This is the format of the invoice title. 783 ;; The first ~a is "Invoice", "Credit Note"... and the second the number. 784 ;; Replace " #" by whatever is common as number abbreviation, i.e. "~a Nr. ~a" 785 (invoice-title (format #f (G_"~a #~a") title (gncInvoiceGetID invoice))) 786 (layout-lookup-table (list (cons 'none #f) 787 (cons 'picture (gnc:make-html-div/markup 788 "picture" 789 (make-img (opt-val "Layout" "Picture Location")))) 790 (cons 'invoice (gnc:make-html-div/markup 791 "invoice-details-table" 792 (make-invoice-details-table 793 invoice options))) 794 (cons 'client (gnc:make-html-div/markup 795 "client-table" 796 (make-client-table 797 owner orders options))) 798 (cons 'company (gnc:make-html-div/markup 799 "company-table" 800 (make-company-table book))) 801 (cons 'today (gnc:make-html-div/markup 802 "invoice-print-date" 803 (qof-print-date (current-time)))))) 804 (layout-lookup (lambda (loc) (cdr (assq (opt-val "Layout" loc) layout-lookup-table))))) 805 806 (gnc:html-document-set-style-text! document (opt-val "Layout" "CSS")) 807 808 (let ((main-table (gnc:make-html-table))) 809 810 (gnc:html-table-append-row! main-table 811 (gnc:make-html-table-cell/size 812 1 2 (gnc:make-html-div/markup 813 "invoice-title" invoice-title))) 814 815 (gnc:html-table-append-row! main-table 816 (list (layout-lookup "Row 1 Left") 817 (gnc:make-html-div/markup 818 "div-align-right" 819 (layout-lookup "Row 1 Right")))) 820 821 (gnc:html-table-append-row! main-table 822 (list (layout-lookup "Row 2 Left") 823 (gnc:make-html-div/markup 824 "div-align-right" 825 (layout-lookup "Row 2 Right")))) 826 827 (gnc:html-table-append-row! main-table 828 (list (layout-lookup "Row 3 Left") 829 (gnc:make-html-div/markup 830 "div-align-right" 831 (layout-lookup "Row 3 Right")))) 832 833 (gnc:html-table-append-row! main-table 834 (gnc:make-html-table-cell/size 835 1 2 (gnc:make-html-div/markup 836 "entries-table" 837 (make-entry-table invoice options 838 cust-doc? credit-note?)))) 839 840 (if (opt-val "Display" "Invoice Notes") 841 (let ((notes (gncInvoiceGetNotes invoice))) 842 (gnc:html-table-append-row! main-table 843 (gnc:make-html-table-cell/size 844 1 2 (gnc:make-html-div/markup 845 "invoice-notes" 846 (multiline-to-html-text notes)))))) 847 848 (if (opt-val "Display" "Payable to") 849 (let* ((name (gnc:company-info book gnc:*company-name*)) 850 (name-str (opt-val "Display" "Payable to string"))) 851 (if (and name (not (string-null? name))) 852 (gnc:html-table-append-row! 853 main-table 854 (gnc:make-html-div/markup 855 "invoice-footer-payable-to" 856 (multiline-to-html-text 857 (string-append name-str ": " name))))))) 858 859 (if (opt-val "Display" "Company contact") 860 (let* ((contact (gnc:company-info book gnc:*company-contact*)) 861 (contact-str (opt-val "Display" "Company contact string"))) 862 (if (and contact (not (string-null? contact))) 863 (gnc:html-table-append-row! 864 main-table 865 (gnc:make-html-div/markup 866 "invoice-footer-company-contact" 867 (multiline-to-html-text 868 (string-append contact-str ": " contact))))))) 869 870 (gnc:html-table-append-row! main-table 871 (gnc:make-html-table-cell/size 872 1 2 (gnc:make-html-div/markup 873 "invoice-notes" 874 (multiline-to-html-text 875 (opt-val "Display" "Extra Notes"))))) 876 877 (gnc:html-document-add-object! document (gnc:make-html-div/markup 878 "main-table" main-table))))) 879 880 document)) 881 882(define invoice-report-guid "5123a759ceb9483abf2182d01c140e8d") 883(define easy-invoice-guid "67112f318bef4fc496bdc27d106bbda4") 884(define fancy-invoice-guid "3ce293441e894423a2425d7a22dd1ac6") 885 886(gnc:define-report 887 'version 1 888 'name (N_ "Printable Invoice") 889 'report-guid invoice-report-guid 890 'menu-path (list gnc:menuname-business-reports) 891 'options-generator (lambda () (options-generator 'invoice)) 892 'renderer reg-renderer 893 'in-menu? #t) 894 895(gnc:define-report 896 'version 1 897 'name (N_ "Easy Invoice") 898 'report-guid easy-invoice-guid 899 'menu-path (list gnc:menuname-business-reports) 900 'options-generator (lambda () (options-generator 'easy-invoice)) 901 'renderer reg-renderer 902 'in-menu? #t) 903 904(gnc:define-report 905 'version 1 906 'name (N_ "Fancy Invoice") 907 'report-guid fancy-invoice-guid 908 'menu-path (list gnc:menuname-business-reports) 909 'options-generator (lambda () (options-generator 'fancy-invoice)) 910 'renderer reg-renderer 911 'in-menu? #t) 912 913