cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Avoid calling display when processing sxml

Browse source 
As I think this could cause suspendable ports issues.
This commit is contained in:
Christopher Baines 2025-06-19 09:53:06 +01:00
parent 9f431462db
commit a75c998739
1 changed files with 7 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
guix-data-service/web/sxml.scm
View file

@ -29,6 +29,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 hash-table) #:use-module (ice-9 hash-table)
#:use-module (ice-9 textual-ports)
#:export (sxml->html)) #:export (sxml->html))
(define %self-closing-tags (define %self-closing-tags
@ -310,7 +311,7 @@
(let ((escaped (hash-ref %escape-chars c))) (let ((escaped (hash-ref %escape-chars c)))
(if escaped (if escaped
(format port "&~a;" escaped) (format port "&~a;" escaped)
(display c port)))) (put-char port c))))
(string-for-each escape s)) (string-for-each escape s))
(define (object->escaped-html obj port) (define (object->escaped-html obj port)
@ -329,7 +330,7 @@
"Write ATTR and VALUE to PORT." "Write ATTR and VALUE to PORT."
(format port "~a=\"" attr) (format port "~a=\"" attr)
(attribute-value->html value port) (attribute-value->html value port)
(display #\" port)) (put-char port #\"))
(define (element->html tag attrs body port) (define (element->html tag attrs body port)
"Write the HTML TAG to PORT, where TAG has the attributes in the "Write the HTML TAG to PORT, where TAG has the attributes in the
@ -337,13 +338,13 @@ list ATTRS and the child nodes in BODY."
(format port "<~a" tag) (format port "<~a" tag)
(for-each (match-lambda (for-each (match-lambda
((attr value) ((attr value)
(display #\space port) (put-char port #\space)
(attribute->html attr value port))) (attribute->html attr value port)))
attrs) attrs)
(if (and (null? body) (self-closing-tag? tag)) (if (and (null? body) (self-closing-tag? tag))
(display " />" port) (put-string port " />")
(begin (begin
(display #\> port) (put-char port #\>)
(for-each (cut sxml->html <> port) body) (for-each (cut sxml->html <> port) body)
(format port "</~a>" tag)))) (format port "</~a>" tag))))
@ -358,7 +359,7 @@ list ATTRS and the child nodes in BODY."
(doctype->html type port)) (doctype->html type port))
;; Unescaped, raw HTML output ;; Unescaped, raw HTML output
(('raw html) (('raw html)
(display html port)) (put-string port html))
(('*ENTITY* name) (('*ENTITY* name)
(simple-format port "&~A;" name)) (simple-format port "&~A;" name))
(((? symbol? tag) ('@ attrs ...) body ...) (((? symbol? tag) ('@ attrs ...) body ...)