IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2024-11-30 20:54:08 -06:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
which was badly written. compact, and create tests.
This commit is contained in:
Christopher Lam 2019-02-08 15:42:29 +08:00
parent 4a2b5e9641
commit 971be33951
3 changed files with 65 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
gnucash/report/report-system/html-fonts.scm
View File

@ -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*
(
(font-family "Arial")
(font-size "20")
(font-style #f)
(font-style-idx 0)
(font-weight #f)
(font-weight-idx 0)
(result "")
(len (string-length font-name))
(idx 0)
)
(set! idx (string-index-right font-name #\space))
(set! font-size (substring font-name (+ idx 1) len))
(set! font-name (string-take font-name idx))
(set! font-weight-idx (string-contains-ci font-name " bold"))
(if font-weight-idx
(begin
(set! font-weight "bold")
(set! font-name (string-append (string-take font-name font-weight-idx)
(string-drop font-name (+ font-weight-idx 5))))
))
(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
))
(let* ((font-style "")
(font-weight "")
(idx (string-index-right font-name #\space))
(font-size (substring font-name (1+ idx) (string-length font-name)))
(font-name (string-take font-name idx)))
(when (string-contains-ci font-name " bold")
(set! font-weight "font-weight: bold; ")
(set! font-name (string-strip font-name " bold")))
(cond
((string-contains-ci font-name " italic")
(set! font-style "font-style: italic; ")
(set! font-name (string-strip font-name " italic")))
((string-contains-ci font-name " oblique")
(set! font-style "font-style: oblique; ")
(set! font-name (string-strip font-name " oblique"))))
(string-append "font-family: " font-name ", Sans-Serif; "
"font-size: " font-size "pt; "
font-style font-weight)))
;; Registers font options
(define (register-font-options options)

1
gnucash/report/report-system/test/CMakeLists.txt
View File

@ -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
)

36
gnucash/report/report-system/test/test-html-fonts.scm Normal file
View File

@ -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"))