[Gnucash-changes] r13233 - gnucash/trunk - Rework some APIs for the
fancy-invoice set the client name font. #327545.
Derek Atkins
warlord at cvs.gnucash.org
Sun Feb 12 11:16:20 EST 2006
Author: warlord
Date: 2006-02-12 11:16:20 -0500 (Sun, 12 Feb 2006)
New Revision: 13233
Trac: http://svn.gnucash.org/trac/changeset/13233
Modified:
gnucash/trunk/ChangeLog
gnucash/trunk/src/business/business-core/business-core.scm
gnucash/trunk/src/business/business-reports/fancy-invoice.scm
Log:
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.
Modified: gnucash/trunk/ChangeLog
===================================================================
--- gnucash/trunk/ChangeLog 2006-02-12 15:28:58 UTC (rev 13232)
+++ gnucash/trunk/ChangeLog 2006-02-12 16:16:20 UTC (rev 13233)
@@ -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 at ihtfp.com>
* src/report/report-gnome/gnc-plugin-page-report.c:
Modified: gnucash/trunk/src/business/business-core/business-core.scm
===================================================================
--- gnucash/trunk/src/business/business-core/business-core.scm 2006-02-12 15:28:58 UTC (rev 13232)
+++ gnucash/trunk/src/business/business-core/business-core.scm 2006-02-12 16:16:20 UTC (rev 13233)
@@ -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,30 +21,54 @@
(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
(gnc:owner-get-type owner) #f)))
@@ -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)
Modified: gnucash/trunk/src/business/business-reports/fancy-invoice.scm
===================================================================
--- gnucash/trunk/src/business/business-reports/fancy-invoice.scm 2006-02-12 15:28:58 UTC (rev 13232)
+++ gnucash/trunk/src/business/business-reports/fancy-invoice.scm 2006-02-12 16:16:20 UTC (rev 13233)
@@ -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>"))
More information about the gnucash-changes
mailing list