suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xexpr: add current-unescaped-tags to disable escaping for certain tags

Browse Source
This commit is contained in:
Bogdan Popa 2021-03-29 13:50:07 +03:00 committed by Jay McCarthy
parent 1a1018d9fe
commit 6535f4f2b8
4 changed files with 51 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/racket-doc/xml/xml.scrbl
View File

@ -416,6 +416,25 @@ or otherwise escaping. Results from the leaves are combined with
@section{Parameters}
@defparam[current-unescaped-tags tags (listof symbol?) #:value null]{
A parameter that determines which tags' string contents should not
be escaped. For backwards compatibility, this defaults to the empty
list.
}
@defthing[html-unescaped-tags (listof symbol?) #:value '(script style)]{
The list of tags whose contents are normally not escaped in HTML.
See @racket[current-unescaped-tags].
@examples[
#:eval xml-eval
(parameterize ([current-unescaped-tags html-unescaped-tags])
(write-xexpr '(html
(p "1 < 2")
(script "1 < 2"))))
]
}
@defparam[empty-tag-shorthand shorthand (or/c (one-of/c 'always 'never) (listof symbol?))]{
A parameter that determines whether output functions should use the

17
pkgs/racket-test/tests/xml/test.rkt
View File

@ -826,6 +826,23 @@ XML
"<root>&#40;</root>")
(test-xexpr->string '(root () "\f")
"<root>\f</root>")
(test-equal?
"escapes"
(xexpr->string
'(html
(p "1 < 2")
(script () "1 < 2")))
"<html><p>1 &lt; 2</p><script>1 &lt; 2</script></html>")
(test-equal?
"unescaped tags"
(parameterize ([current-unescaped-tags '(script)])
(xexpr->string
'(html
(p "1 < 2")
(script "1 < 2"))))
"<html><p>1 &lt; 2</p><script>1 < 2</script></html>")
; XXX more xexpr->string tests
)

10
racket/collects/xml/private/writer.rkt
View File

@ -12,7 +12,9 @@
[write-xml/content ((content/c) (output-port?) . ->* . void?)]
[display-xml/content ((content/c) (output-port? #:indentation indentation?) . ->* . void?)]
[empty-tag-shorthand (parameter/c (or/c (symbols 'always 'never) (listof symbol?)))]
[html-empty-tags (listof symbol?)])
[html-empty-tags (listof symbol?)]
[html-unescaped-tags (listof symbol?)]
[current-unescaped-tags (parameter/c (listof symbol?))])
(define html-empty-tags
'(param meta link isindex input img hr frame col br basefont base area))
@ -26,6 +28,12 @@
x
(error 'empty-tag-shorthand "expected 'always, 'never, or a list of symbols: received ~e" x)))))
(define html-unescaped-tags
'(script style))
(define current-unescaped-tags
(make-parameter null))
;; indent : Nat Output-port -> Void
(define (indent n out)
(newline out)

9
racket/collects/xml/private/xexpr.rkt
View File

@ -110,7 +110,8 @@
(define (write-xexpr x [out (current-output-port)]
#:insert-newlines? [insert-newlines? #f])
(define short (empty-tag-shorthand))
(let loop ([x x])
(define unescaped (current-unescaped-tags))
(let loop ([x x] [escape? #t])
(cond
; Element
[(cons? x)
@ -145,14 +146,16 @@
(write-bytes #">" out)
; Write body
(for ([xe (in-list content)])
(loop xe))
(loop xe (not (memq name unescaped))))
; Write closing tag
(write-bytes #"</" out)
(write-string (symbol->immutable-string name) out)
(write-bytes #">" out)])]
; PCData
[(string? x)
(write-string/escape x escape-table out)]
(if escape?
(write-string/escape x escape-table out)
(write-string x out))]
; Entities
[(symbol? x)
(write-bytes #"&" out)