mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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:
@@ -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:
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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>"))
|
||||
|
||||
Reference in New Issue
Block a user