[html-fonts] compact (font-name-to-style-info)

which was badly written. compact, and create tests.

gnucash/report/report-system/html-fonts.scm

@@ -27,53 +27,36 @@
 
 (use-modules (gnucash gettext))
 
+(define (string-strip s1 s2)
+  (let ((idx (string-contains-ci s1 s2)))
+    (string-append
+     (string-take s1 idx)
+     (string-drop s1 (+ idx (string-length s2))))))
+
 ;; Converts a font name to css style information
 (define (font-name-to-style-info font-name)
-    (let*
+  (let* ((font-style "")
-	  (
+         (font-weight "")
-	    (font-family "Arial")
+         (idx (string-index-right font-name #\space))
-	    (font-size "20")
+         (font-size (substring font-name (1+ idx) (string-length font-name)))
-		(font-style #f)
+         (font-name (string-take font-name idx)))
-		(font-style-idx 0)
+
-		(font-weight #f)
+    (when (string-contains-ci font-name " bold")
-		(font-weight-idx 0)
+      (set! font-weight "font-weight: bold; ")
-		(result "")
+      (set! font-name (string-strip font-name " bold")))
-		(len (string-length font-name))
+
-		(idx 0)
+    (cond
-	  )
+     ((string-contains-ci font-name " italic")
-	(set! idx (string-index-right font-name #\space))
+      (set! font-style "font-style: italic; ")
-	(set! font-size (substring font-name (+ idx 1) len))
+      (set! font-name (string-strip font-name " italic")))
-	(set! font-name (string-take font-name idx))
+
-	(set! font-weight-idx (string-contains-ci font-name " bold"))
+     ((string-contains-ci font-name " oblique")
-	(if font-weight-idx
+      (set! font-style "font-style: oblique; ")
-	    (begin
+      (set! font-name (string-strip font-name " oblique"))))
-		    (set! font-weight "bold")
+
-			(set! font-name (string-append (string-take font-name font-weight-idx)
+    (string-append "font-family: " font-name ", Sans-Serif; "
-			                               (string-drop font-name (+ font-weight-idx 5))))
+                   "font-size: " font-size "pt; "
-		))
+                   font-style font-weight)))
-	(set! font-style-idx (string-contains-ci font-name " italic"))
-	(if font-style-idx
-	    (begin
-		    (set! font-style "italic")
-			(set! font-name (string-append (string-take font-name font-style-idx)
-			                               (string-drop font-name (+ font-style-idx 7))))
-		)
-		(begin
-			(set! font-style-idx (string-contains-ci font-name " oblique"))
-			(if font-style-idx
-				(begin
-					(set! font-style "oblique")
-					(set! font-name (string-append (string-take font-name font-style-idx)
-												   (string-drop font-name (+ font-style-idx 8))))
-		))))
-	(set! font-family font-name)
-	(set! result (string-append
-		"font-family: " font-family ", Sans-Serif; "
-		"font-size: " font-size "pt; "
-		(if font-style (string-append "font-style: " font-style "; ") "")
-		(if font-weight (string-append "font-weight: " font-weight "; ") "")))
-	result
-    ))
 
 ;; Registers font options
 (define (register-font-options options)

gnucash/report/report-system/test/CMakeLists.txt

@@ -18,6 +18,7 @@ set (scm_test_report_system_with_srfi64_SOURCES
   test-commodity-utils.scm
   test-report-utilities.scm
   test-html-utilities-srfi64.scm
+  test-html-fonts.scm
   test-report-html.scm
   test-report-system.scm
   )

gnucash/report/report-system/test/test-html-fonts.scm

@@ -0,0 +1,36 @@
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(load "../html-fonts.scm")
+
+(setlocale LC_ALL "C")
+
+(define (run-test)
+  (test-runner-factory gnc:test-runner)
+  (test-begin "html-fonts")
+  (test-font-name-to-style-info)
+  (test-end "html-fonts"))
+
+(define (test-font-name-to-style-info)
+  (test-begin "font-name-to-style-info")
+
+  (test-equal "basic"
+    "font-family: Courier Regular, Sans-Serif; font-size: 20pt; "
+    (font-name-to-style-info "Courier Regular 20"))
+
+  (test-equal "basic size 50"
+    "font-family: Courier Regular, Sans-Serif; font-size: 50pt; "
+    (font-name-to-style-info "Courier Regular 50"))
+
+  (test-equal "basic size 50 bold"
+    "font-family: Courier, Sans-Serif; font-size: 50pt; font-weight: bold; "
+    (font-name-to-style-info "Courier bold 50"))
+
+  (test-equal "basic size 50 italic"
+    "font-family: Courier, Sans-Serif; font-size: 50pt; font-style: italic; "
+    (font-name-to-style-info "Courier italic 50"))
+
+  (test-equal "basic size 15 oblique"
+    "font-family: Courier, Sans-Serif; font-size: 15pt; font-style: oblique; "
+    (font-name-to-style-info "Courier oblique 15"))
+
+  (test-end "font-name-to-style-info"))