From 48772d315a48c4cb14b272e4d517506c2f00d4bd Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 15 Jul 1988 22:31:04 +0000
Subject: [PATCH] Change string unparser to notice character sets and unparse
 them specially.  Also notice non-graphic characters in strings and, when
 slashifying, unparse them using octal escape sequence.

---
 v7/src/runtime/unpars.scm | 69 ++++++++++++++++++++++++---------------
 1 file changed, 43 insertions(+), 26 deletions(-)

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 9c710322c..5f57347fa 100644
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.3 1988/07/07 16:14:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.4 1988/07/15 22:31:04 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -38,7 +38,8 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define (initialize-package!)
-  (set! string-delimiters (char-set #\" #\\ #\Tab #\Newline #\Page))
+  (set! string-delimiters
+	(char-set-union char-set:not-graphic (char-set #\" #\\)))
   (set! hook/interned-symbol unparse-symbol)
   (set! *unparser-radix* 10)
   (set! *unparser-list-breadth-limit* false)
@@ -277,30 +278,46 @@ MIT in each case. |#
       (*unparse-char character)))
 
 (define (unparse/string string)
-  (if *slashify?*
-      (begin (*unparse-char #\")
-	     (let ((end (string-length string)))
-	       (define (loop start)
-		 (let ((index
-			(substring-find-next-char-in-set string start end
-							 string-delimiters)))
-		   (if index
-		       (begin (*unparse-substring string start index)
-			      (*unparse-char #\\)
-			      (*unparse-char
-			       (let ((char (string-ref string index)))
-				 (cond ((char=? char #\Tab) #\t)
-				       ((char=? char char:newline) #\n)
-				       ((char=? char #\Page) #\f)
-				       (else char))))
-			      (loop (1+ index)))
-			  (*unparse-substring string start end))))
-	       (if (substring-find-next-char-in-set string 0 end
-						    string-delimiters)
-		   (loop 0)
-		   (*unparse-string string)))
-	     (*unparse-char #\"))
-      (*unparse-string string)))
+  (cond ((char-set? string)
+	 (*unparse-with-brackets 'CHARACTER-SET string false))
+	(*slashify?*
+	 (*unparse-char #\")
+	 (let ((end (string-length string)))
+	   (define (loop start)
+	     (let ((index
+		    (substring-find-next-char-in-set string start end
+						     string-delimiters)))
+	       (if index
+		   (begin (*unparse-substring string start index)
+			  (*unparse-char #\\)
+			  (let ((char (string-ref string index)))
+			    (cond ((char=? char #\Tab)
+				   (*unparse-char #\t))
+				  ((char=? char char:newline)
+				   (*unparse-char #\n))
+				  ((char=? char #\Page)
+				   (*unparse-char #\f))
+				  ((or (char=? char #\\)
+				       (char=? char #\"))
+				   (*unparse-char char))
+				  (else
+				   (*unparse-string (char->octal char)))))
+			  (loop (1+ index)))
+		   (*unparse-substring string start end))))
+	   (if (substring-find-next-char-in-set string 0 end
+						string-delimiters)
+	       (loop 0)
+	       (*unparse-string string)))
+	 (*unparse-char #\"))
+	(else
+	 (*unparse-string string))))
+
+(define (char->octal char)
+  (let ((qr1 (integer-divide (char->ascii char) 8)))
+    (let ((qr2 (integer-divide (integer-divide-quotient qr1) 8)))
+      (char->string (digit->char (integer-divide-quotient qr2) 8)
+		    (digit->char (integer-divide-remainder qr2) 8)
+		    (digit->char (integer-divide-remainder qr1) 8)))))
 
 (define string-delimiters)
 
-- 
2.25.1