TakeV
/
guile-toml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix(encoder): escaping control character

This commit is contained in:
hylo 2022-12-30 17:53:13 +01:00
parent 88467007a3
commit 9f6912f6e5
1 changed files with 25 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
toml/builder.scm
View File

@ -54,8 +54,20 @@
(build-key (car p) port)
(put-string port " = ")
(toml-build (cdr p) port #:newline? newline? #:inline? inline?))
;; (define (escape-special c))
(define* (escape-control-characters s #:optional (literal-nl? #f))
(define (char->unicode-hex c)
(define hex-unpadded (number->string (char->integer c) 16))
(define zeroes (make-string (- 4 (string-length hex-unpadded)) #\0))
(string-append "\\u" zeroes hex-unpadded))
(apply string-append (map (lambda (c)
(cond
((and literal-nl? (eq? c #\newline))
"\n")
((eq? 'Cc (char-general-category c))
(char->unicode-hex c))
(else (string c))))
(string->list s))))
(define (toml-build-string s port)
(define quote-type (if (or
@ -64,8 +76,18 @@
(define surround (if (string-contains s "\n")
(make-string 3 quote-type)
(string quote-type)))
;; (define surround (make-string 1 quote-type))
(put-string port surround)
(put-string port s)
(put-string port (escape-control-characters s #t))
(put-string port surround))
(define (toml-build-key-string s port)
(define quote-type (if (or
(string-contains s "\\")
(string-contains s "\"")) #\' #\"))
(define surround (make-string 1 quote-type))
(put-string port surround)
(put-string port (escape-control-characters s))
(put-string port surround))
(define (build-keys lst port)
@ -81,7 +103,7 @@
(loop (cdr lst))))))
(define (build-key s port)
(toml-build-string s port))
(toml-build-key-string s port))
(define (build-table scm port current-table)
(define new-table (append current-table (list (car scm))))