mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[eguile-html-utilities] dedupe, fix html
* 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:
parent
c81e9354f7
commit
326927215c
@ -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 < > and & 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 "&" 'post))
|
|
||||||
(set! s1 (regexp-substitute/global #f "<" s1 'pre "<" 'post))
|
|
||||||
(regexp-substitute/global #f ">" s1 'pre ">" '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 (non-breaking spaces)
|
;; Replace spaces with (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 " " 'post)
|
(string-substitute-alist str '((#\space . " ")))
|
||||||
"</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 s are just there in case CSS isn't working)
|
;; (the s are just there in case CSS isn't working)
|
||||||
(display (string-repeat "<td min-width=\"32\" class=\"indent\"> </td>" n)))
|
(display
|
||||||
|
(string-repeat "<td min-width=\"32\" class=\"indent\"> </td>" n)))
|
||||||
|
|
||||||
(define-public (negstyle item)
|
(define-public (negstyle item)
|
||||||
;; apply styling for negative amounts
|
;; apply styling for negative amounts
|
||||||
@ -86,9 +82,13 @@
|
|||||||
(define-public (display-comm-coll-total comm-coll negative?)
|
(define-public (display-comm-coll-total comm-coll negative?)
|
||||||
;; Display the total(s) of a commodity collector as HTML
|
;; Display the total(s) of a commodity collector as HTML
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (pair)
|
(lambda (pair)
|
||||||
(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.
|
||||||
@ -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 "\";")))
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user