IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[eguile-html-utilities] dedupe, fix html

Browse Source 
* prefer srfi-13 over regex
* instead of <nobr> use <span style="white-space:nowrap">
* reuse functions defined in eguile-gnc and eguile-utilities
* compact functions
* move make-regexp toplevel to ensure one compilation
This commit is contained in:
Christopher Lam 2019-07-28 14:36:22 +08:00
parent c81e9354f7
commit 326927215c
1 changed files with 37 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
gnucash/report/report-system/eguile-html-utilities.scm
View File

@ -32,29 +32,24 @@
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/app-utils" 0)
(use-modules (gnucash report eguile-gnc))
(use-modules (ice-9 regex)) ; for regular expressions
(use-modules (srfi srfi-13)) ; for extra string functions
(define-public (escape-html s1)
;; Convert string s1 to escape HTML special characters < > and &
;; i.e. convert them to &lt; &gt; and &amp; respectively.
;; Maybe there's a way to do this in one go... (but order is important)
(set! s1 (regexp-substitute/global #f "&" s1 'pre "&amp;" 'post))
(set! s1 (regexp-substitute/global #f "<" s1 'pre "&lt;" 'post))
(regexp-substitute/global #f ">" s1 'pre "&gt;" 'post))
(define (string-repeat s n)
;; return a string made of n copies of string s
(string-join (make-list n s) ""))
(define-public (nl->br str)
;; Replace newlines with <br>
(regexp-substitute/global #f "\n" str 'pre "<br>" 'post))
(string-substitute-alist str '((#\newline . "<br/>"))))
(define-public (nbsp str)
;; Replace spaces with &nbsp; (non-breaking spaces)
;; (yes, I know <nobr> is non-standard, but webkit splits e.g. "-£40.00" between
;; the '-' and the '£' without it.)
(string-append
"<nobr>"
(regexp-substitute/global #f " " str 'pre "&nbsp;" 'post)
"</nobr>"))
(string-append
"<span style=\"white-space:nowrap;\">"
(string-substitute-alist str '((#\space . "&nbsp;")))
"</span>"))
(define-public (empty-cells n)
;; Display n empty table cells
@ -63,7 +58,8 @@
(define-public (indent-cells n)
;; Display n empty table cells with width attribute for indenting
;; (the &nbsp;s are just there in case CSS isn't working)
(display (string-repeat "<td min-width=\"32\" class=\"indent\">&nbsp;&nbsp;</td>" n)))
(display
(string-repeat "<td min-width=\"32\" class=\"indent\">&nbsp;&nbsp;</td>" n)))
(define-public (negstyle item)
;; apply styling for negative amounts
@ -86,9 +82,13 @@
(define-public (display-comm-coll-total comm-coll negative?)
;; Display the total(s) of a commodity collector as HTML
(for-each
(lambda (pair)
(display (nbsp (gnc:monetary->string pair))))
(comm-coll 'format gnc:make-gnc-monetary negative?)))
(lambda (pair)
(display (nbsp (gnc:monetary->string pair))))
(comm-coll 'format gnc:make-gnc-monetary negative?)))
;; (thanks to Peter Brett for this regexp and the use of match:prefix)
(define fontre
(make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase))
(define-public (font-name-to-style-info font-name)
;;; Convert a font name as return by a font option to CSS format.
@ -98,31 +98,28 @@
(font-weight "normal")
(font-style "normal")
(font-size "medium")
(match "")
; (thanks to Peter Brett for this regexp and the use of match:prefix)
(fontre (make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase))
(match (regexp-exec fontre font-name)))
(if match
(begin
; font name parsed OK -- assemble the bits for CSS
(set! font-family (match:prefix match))
(if (match:substring match 2)
; weight given -- some need translating
(when match
;; font name parsed OK -- assemble the bits for CSS
(set! font-family (match:prefix match))
(if (match:substring match 2)
;; weight given -- some need translating
(let ((weight (match:substring match 2)))
(cond
((string-ci=? weight "bold") (set! font-weight "bold"))
((string-ci=? weight "semi-bold") (set! font-weight "600"))
((string-ci=? weight "light") (set! font-weight "200")))))
(if (match:substring match 4)
; style
((string-ci=? weight "bold") (set! font-weight "bold"))
((string-ci=? weight "semi-bold") (set! font-weight "600"))
((string-ci=? weight "light") (set! font-weight "200")))))
(if (match:substring match 4)
;; style
(let ((style (match:substring match 4)))
(cond
((string-ci=? style "italic") (set! font-style "italic"))
((string-ci=? style "oblique") (set! font-style "oblique")))))
; ('condensed' is ignored)
(if (match:substring match 7)
; size is in points
(set! font-size (string-append (match:substring match 7) "pt")))))
; construct the result (the order of these is important)
(string-append "font: " font-weight " " font-style " " font-size " \"" font-family "\";")))
((string-ci=? style "italic") (set! font-style "italic"))
((string-ci=? style "oblique") (set! font-style "oblique")))))
;; ('condensed' is ignored)
(if (match:substring match 7)
;; size is in points
(set! font-size (string-append (match:substring match 7) "pt"))))
;; construct the result (the order of these is important)
(string-append "font: " font-weight " " font-style
" " font-size " \"" font-family "\";")))