[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