On Tue, Mar 05, 2013 at 06:48:44PM +0100, Florian Zumbiehl wrote:
> Encode DEL (ASCII character 127) in strings as \x7f instead of as literal DEL
> in write.
Thanks for this (and the other) patch! Here's a signed-off version,
which other team members may push. I also nominate this patch for
inclusion in the stability branch.
I've changed write to output \a for BEL as well, so that strings are
output as compactly as possible.
I've reformatted and reflowed the PP code so it doesn't go as far beyond
column 80 anymore. I've also fixed the output of #\alarm to be \a
(in your patch \b, but that's backspace, which I've also added).
I've also added a basic test for these escaped characters to pp-test.scm
BTW: Can anyone tell me why there's (test "\\" "\\") as the final line
in that file? It should always pass, and has nothing to do with writing.
Cheers,
Peter
--
http://www.more-magic.net
>From 50eade1e10127bbbdaa8496822ce26061a75ab8c Mon Sep 17 00:00:00 2001
From: Florian Zumbiehl <fl...@florz.de>
Date: Tue, 5 Mar 2013 18:48:44 +0100
Subject: [PATCH 1/3] write: escape DEL character in strings, encode BEL as \a
Encode DEL (ASCII character 127) in strings as \x7f instead of as literal DEL
in write. Also encode BEL (ASCII character 7) as \a instead of \x07, for
consistency.
Signed-off-by: Peter Bex <peter....@xs4all.nl>
---
library.scm | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/library.scm b/library.scm
index f11a4ee..5a2862e 100644
--- a/library.scm
+++ b/library.scm
@@ -3310,15 +3310,17 @@ EOF
((34) (outstr port "\\\""))
((92) (outstr port "\\\\"))
(else
- (cond ((fx< chr 32)
+ (cond ((or (fx< chr 32)
+ (fx= chr 127))
(outchr port #\\)
(case chr
+ ((7) (outchr port #\a))
+ ((8) (outchr port #\b))
((9) (outchr port #\t))
((10) (outchr port #\n))
- ((13) (outchr port #\r))
((11) (outchr port #\v))
((12) (outchr port #\f))
- ((8) (outchr port #\b))
+ ((13) (outchr port #\r))
(else
(outchr port #\x)
(when (fx< chr 16) (outchr port #\0))
--
1.8.0.1
>From 11520831798b489cb16f3eb0ec3d3de3ca579b14 Mon Sep 17 00:00:00 2001
From: Florian Zumbiehl <fl...@florz.de>
Date: Tue, 5 Mar 2013 18:48:58 +0100
Subject: [PATCH 2/3] extras/pretty-print: escape control characters in strings
Make pretty-print encode control characters in strings as escape sequences
rather than as literal bytes, the same way write does it.
Signed-off-by: Peter Bex <peter....@xs4all.nl>
---
extras.scm | 62 +++++++++++++++++++++++++++++++++----------------------
tests/pp-test.scm | 3 ++-
2 files changed, 39 insertions(+), 26 deletions(-)
diff --git a/extras.scm b/extras.scm
index 0e8b144..f6daf1c 100644
--- a/extras.scm
+++ b/extras.scm
@@ -331,31 +331,43 @@
(##sys#print obj #t s)
(out (get-output-string s) col) ) )
((procedure? obj) (out (##sys#procedure->string obj) col))
- ((string? obj) (if display?
- (out obj col)
- (let loop ((i 0) (j 0) (col (out "\"" col)))
- (if (and col (fx< j (string-length obj)))
- (let ((c (string-ref obj j)))
- (if (or (char=? c #\\)
- (char=? c #\"))
- (loop j
- (+ j 1)
- (out "\\"
- (out
(##sys#substring obj i j)
- col)))
- (cond ((assq c '((#\tab .
"\\t")
- (#\newline .
"\\n")
- (#\return .
"\\r")))
- =>
- (lambda (a)
- (let ((col2
- (out
(##sys#substring obj i j) col)))
- (loop (fx+ j 1)
- (fx+ j 1)
- (out (cdr a)
col2)))))
- (else (loop i (fx+ j 1)
col)))))
- (out "\""
- (out (##sys#substring obj i j)
col))))))
+ ((string? obj)
+ (if display?
+ (out obj col)
+ (let loop ((i 0) (j 0) (col (out "\"" col)))
+ (if (and col (fx< j (string-length obj)))
+ (let ((c (string-ref obj j)))
+ (cond
+ ((or (char=? c #\\)
+ (char=? c #\"))
+ (loop j
+ (+ j 1)
+ (out "\\"
+ (out (##sys#substring obj i j)
+ col))))
+ ((or (char<? c #\x20)
+ (char=? c #\x7f))
+ (loop (fx+ j 1)
+ (fx+ j 1)
+ (let ((col2
+ (out (##sys#substring obj i j) col)))
+ (cond ((assq c '((#\tab . "\\t")
+ (#\newline . "\\n")
+ (#\return . "\\r")
+ (#\vtab . "\\v")
+ (#\page . "\\f")
+ (#\alarm . "\\a")
+ (#\backspace . "\\b")))
+ =>
+ (lambda (a)
+ (out (cdr a) col2)))
+ (else
+ (out (number->string (char->integer
c) 16)
+ (out (if (char<? c #\x10) "0" "")
+ (out "\\x" col2))))))))
+ (else (loop i (fx+ j 1) col))))
+ (out "\""
+ (out (##sys#substring obj i j) col))))))
((char? obj) (if display?
(out (make-string 1 obj) col)
(let ([code (char->integer obj)])
diff --git a/tests/pp-test.scm b/tests/pp-test.scm
index 318c982..0af80e4 100644
--- a/tests/pp-test.scm
+++ b/tests/pp-test.scm
@@ -13,4 +13,5 @@
(test "\"\\\\\\\"\"\n" (pp->string "\\\""))
(test "\"\\\\\\\\\\\\\\\"\"\n" (pp->string "\\\\\\\""))
(test "\"\\\"\\\"\\\"\"\n" (pp->string "\"\"\""))
-(test "\\" "\\")
+(test "\"\\n\\t\\r\\b\\a\\v\\f\"\n" (pp->string "\n\t\r\b\a\v\f"))
+(test "\\" "\\") ; XXX?
--
1.8.0.1
>From dfdc2a7f52fec8b2db7d7825c560a32385db62b3 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter....@xs4all.nl>
Date: Tue, 5 Mar 2013 20:30:08 +0100
Subject: [PATCH 3/3] Document changes in pp and write behavior
---
NEWS | 2 ++
1 file changed, 2 insertions(+)
diff --git a/NEWS b/NEWS
index 03df87c..4023338 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@
- Core libraries
- read-line no longer returns trailing CRs in rare cases on TCP ports (#568)
+ - write and pp now correctly use escape sequences for control characters
+ (thanks to Florian Zumbiehl)
- Runtime system
- Special events in poll() are now handled, avoiding hangs in threaded apps.
--
1.8.0.1
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
