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

51
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/report/report-system" 0)
(gnc:module-load "gnucash/app-utils" 0) (gnc:module-load "gnucash/app-utils" 0)
(use-modules (gnucash report eguile-gnc))
(use-modules (ice-9 regex)) ; for regular expressions (use-modules (ice-9 regex)) ; for regular expressions
(use-modules (srfi srfi-13)) ; for extra string functions (use-modules (srfi srfi-13)) ; for extra string functions
(define-public (escape-html s1) (define (string-repeat s n)
;; Convert string s1 to escape HTML special characters < > and & ;; return a string made of n copies of string s
;; i.e. convert them to &lt; &gt; and &amp; respectively. (string-join (make-list n s) ""))
;; 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-public (nl->br str) (define-public (nl->br str)
;; Replace newlines with <br> ;; Replace newlines with <br>
(regexp-substitute/global #f "\n" str 'pre "<br>" 'post)) (string-substitute-alist str '((#\newline . "<br/>"))))
(define-public (nbsp str) (define-public (nbsp str)
;; Replace spaces with &nbsp; (non-breaking spaces) ;; 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 (string-append
"<nobr>" "<span style=\"white-space:nowrap;\">"
(regexp-substitute/global #f " " str 'pre "&nbsp;" 'post) (string-substitute-alist str '((#\space . "&nbsp;")))
"</nobr>")) "</span>"))
(define-public (empty-cells n) (define-public (empty-cells n)
;; Display n empty table cells ;; Display n empty table cells
@ -63,7 +58,8 @@
(define-public (indent-cells n) (define-public (indent-cells n)
;; Display n empty table cells with width attribute for indenting ;; Display n empty table cells with width attribute for indenting
;; (the &nbsp;s are just there in case CSS isn't working) ;; (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) (define-public (negstyle item)
;; apply styling for negative amounts ;; apply styling for negative amounts
@ -90,6 +86,10 @@
(display (nbsp (gnc:monetary->string pair)))) (display (nbsp (gnc:monetary->string pair))))
(comm-coll 'format gnc:make-gnc-monetary negative?))) (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) (define-public (font-name-to-style-info font-name)
;;; Convert a font name as return by a font option to CSS format. ;;; Convert a font name as return by a font option to CSS format.
;;; e.g. "URW Bookman L Bold Italic 12" becomes ;;; e.g. "URW Bookman L Bold Italic 12" becomes
@ -98,31 +98,28 @@
(font-weight "normal") (font-weight "normal")
(font-style "normal") (font-style "normal")
(font-size "medium") (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))) (match (regexp-exec fontre font-name)))
(if match (when match
(begin ;; font name parsed OK -- assemble the bits for CSS
; font name parsed OK -- assemble the bits for CSS
(set! font-family (match:prefix match)) (set! font-family (match:prefix match))
(if (match:substring match 2) (if (match:substring match 2)
; weight given -- some need translating ;; weight given -- some need translating
(let ((weight (match:substring match 2))) (let ((weight (match:substring match 2)))
(cond (cond
((string-ci=? weight "bold") (set! font-weight "bold")) ((string-ci=? weight "bold") (set! font-weight "bold"))
((string-ci=? weight "semi-bold") (set! font-weight "600")) ((string-ci=? weight "semi-bold") (set! font-weight "600"))
((string-ci=? weight "light") (set! font-weight "200"))))) ((string-ci=? weight "light") (set! font-weight "200")))))
(if (match:substring match 4) (if (match:substring match 4)
; style ;; style
(let ((style (match:substring match 4))) (let ((style (match:substring match 4)))
(cond (cond
((string-ci=? style "italic") (set! font-style "italic")) ((string-ci=? style "italic") (set! font-style "italic"))
((string-ci=? style "oblique") (set! font-style "oblique"))))) ((string-ci=? style "oblique") (set! font-style "oblique")))))
; ('condensed' is ignored) ;; ('condensed' is ignored)
(if (match:substring match 7) (if (match:substring match 7)
; size is in points ;; size is in points
(set! font-size (string-append (match:substring match 7) "pt"))))) (set! font-size (string-append (match:substring match 7) "pt"))))
; construct the result (the order of these is important) ;; construct the result (the order of these is important)
(string-append "font: " font-weight " " font-style " " font-size " \"" font-family "\";"))) (string-append "font: " font-weight " " font-style
" " font-size " \"" font-family "\";")))