Rework some APIs for the fancy-invoice set the client name font. #327545.

* src/business/business-core/business-core.scm:
	  add gnc:owner-get-name-dep and gnc:owner-get-address-dep APIs
	* src/business/business-reports/fancy-invoice.scm:
	  Change the font of the client company name to match the
	  owner company name.  Fixes #327545.



git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@13233 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
2006-02-12 16:16:20 +00:00
parent 6dacd59a05
commit dd03084db4
3 changed files with 60 additions and 54 deletions

View File

@@ -5,6 +5,12 @@
gnc:owner-get-name-and-address-dep in preparation of
some other patches.
* src/business/business-core/business-core.scm:
add gnc:owner-get-name-dep and gnc:owner-get-address-dep APIs
* src/business/business-reports/fancy-invoice.scm:
Change the font of the client company name to match the
owner company name. Fixes #327545.
2006-02-11 Derek Atkins <derek@ihtfp.com>
* src/report/report-gnome/gnc-plugin-page-report.c:

View File

@@ -3,38 +3,6 @@
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/engine" 0)
; return a string which is basically:
; name \n Attn: contact \n addr1 \n addr2 \n addr3 \n addr4
;
; But only include the strings that really exist.
;
(define (name-and-addr name addr)
(define (add-if-exists lst new)
(if (and new (> (string-length new) 0))
(cons new lst)
lst))
(define (build-string lst)
(cond
((null? lst) "")
((null? (cdr lst)) (car lst))
(else (string-append (build-string (cdr lst)) "\n" (car lst)))))
(define (unique str)
(if (and name str (string=? name str)) #f str))
(let ((lst '()))
(set! lst (add-if-exists lst name))
(set! lst (add-if-exists lst (unique (gnc:address-get-name addr))))
(set! lst (add-if-exists lst (gnc:address-get-addr1 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr2 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr3 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr4 addr)))
(build-string lst)))
(define (gnc:owner-get-address owner)
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type owner) #f)))
@@ -53,29 +21,53 @@
(gnc:owner-get-job owner))))
(else ""))))
(define (gnc:owner-get-name-and-address-dep owner)
;
; The -dep functions return combined strings of the appropriate
; content. When multiple "lines" are included, separate them
; by newlines.
;
; e.g.: return a string which is basically:
; name \n Attn: contact \n addr1 \n addr2 \n addr3 \n addr4
;
; But only include the strings that really exist.
;
(define (gnc:owner-get-name-dep owner)
(define (just-name name)
(if name name ""))
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type owner) #f)))
(case type
((gnc-owner-customer)
(let ((c (gnc:owner-get-customer owner)))
(name-and-addr
(gnc:customer-get-name c)
(gnc:customer-get-addr c))))
((gnc-owner-vendor)
(let ((v (gnc:owner-get-vendor owner)))
(name-and-addr
(gnc:vendor-get-name v)
(gnc:vendor-get-addr v))))
((gnc-owner-employee)
(let ((e (gnc:owner-get-employee owner)))
(name-and-addr
""
(gnc:employee-get-addr e))))
((gnc-owner-job)
(gnc:owner-get-name-and-address-dep (gnc:job-get-owner
(gnc:owner-get-job owner))))
(else ""))))
(gnc:owner-get-dep-name (gnc:job-get-owner
(gnc:owner-get-job owner))))
(else (just-name (gnc:owner-get-name owner))))))
(define (gnc:owner-get-address-dep owner)
(define (add-if-exists lst new)
(if (and new (> (string-length new) 0))
(cons new lst)
lst))
(define (build-string lst)
(cond
((null? lst) "")
((null? (cdr lst)) (car lst))
(else (string-append (build-string (cdr lst)) "\n" (car lst)))))
(let ((lst '())
(addr (gnc:owner-get-address owner)))
(set! lst (add-if-exists lst (gnc:address-get-addr1 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr2 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr3 addr)))
(set! lst (add-if-exists lst (gnc:address-get-addr4 addr)))
(build-string lst)))
(define (gnc:owner-get-name-and-address-dep owner)
(let ((name (gnc:owner-get-name-dep owner))
(addr (gnc:owner-get-address-dep owner)))
(if (> (string-length name) 0)
(string-append name "\n" addr)
addr)))
(define (gnc:owner-get-owner-id owner)
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
@@ -134,6 +126,8 @@
(export gnc:owner-get-address)
(export gnc:owner-get-name-dep)
(export gnc:owner-get-address-dep)
(export gnc:owner-get-name-and-address-dep)
(export gnc:owner-get-owner-id)
(export gnc:entry-type-percent-p)

View File

@@ -566,17 +566,23 @@
(line-helper (string->list string)))
(define (make-client-table owner orders)
;; oli-custom - FIXME: font for client company name should be at least size +1.
(let ((table (gnc:make-html-table)))
(let ((table (gnc:make-html-table))
(name-cell (gnc:make-html-table-cell)))
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 0)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
(gnc:html-table-cell-append-objects!
name-cell (gnc:owner-get-name-dep owner))
(gnc:html-table-cell-set-style!
name-cell "td"
'font-size "+2")
(gnc:html-table-append-row! table (list name-cell #\newline "<br>"))
(gnc:html-table-append-row!
table
(list
(string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br>")))
(string-expand (gnc:owner-get-address-dep owner) #\newline "<br>")))
(gnc:html-table-append-row!
table
(list "<br>"))