Add hack to force printing chars in old format; can be eliminated after 9.3.
authorChris Hanson <org/chris-hanson/cph>
Sun, 19 Mar 2017 02:34:17 +0000 (19:34 -0700)
committerChris Hanson <org/chris-hanson/cph>
Sun, 19 Mar 2017 02:34:17 +0000 (19:34 -0700)
src/runtime/runtime.pkg
src/runtime/unpars.scm

index 69238b248eb760f8a71d23e24dc42a0105406b8f..8b5850eafa30d23a7fbfb577352af8ec4bb4e396 100644 (file)
@@ -4735,6 +4735,7 @@ USA.
          *unparser-string-length-limit*)
   (export ()
          param:unparse-abbreviate-quotations?
+         param:unparse-char-in-unicode-syntax?
          param:unparse-compound-procedure-names?
          param:unparse-primitives-by-name?
          param:unparse-streams?
index 7fdf33bcf609a6530fadf08e7c06577937fe0bb7..d9d894670e7a3f5f436e279d8b8446ff4a6dc35f 100644 (file)
@@ -52,6 +52,7 @@ USA.
 (define param:unparser-list-depth-limit)
 (define param:unparser-radix)
 (define param:unparser-string-length-limit)
+(define param:unparse-char-in-unicode-syntax?)
 
 (add-boot-init!
  (lambda ()
@@ -88,6 +89,9 @@ USA.
    (set! param:unparser-string-length-limit
         (make-unsettable-parameter #f
                                    limit-converter))
+   (set! param:unparse-char-in-unicode-syntax?
+        (make-unsettable-parameter #f
+                                   boolean-converter))
    unspecific))
 
 (define (boolean-converter value)
@@ -480,15 +484,19 @@ USA.
             (allowed-char? char context))))
 \f
 (define (unparse/character char context)
-  (if (context-slashify? context)
-      (begin
-        (*unparse-string "#\\" context)
-       (if (and (char-in-set? char char-set:normal-printing)
-                 (not (eq? 'separator:space (char-general-category char)))
-                (allowed-char? char context))
-           (*unparse-char char context)
-           (*unparse-string (char->name char) context)))
-      (*unparse-char char context)))
+  (cond ((and (param:unparse-char-in-unicode-syntax?)
+             (bitless-char? char))
+        (*unparse-string "#\\u+" context)
+        (*unparse-string (number->string (char->integer char) 16) context))
+       ((context-slashify? context)
+        (*unparse-string "#\\" context)
+        (if (and (char-in-set? char char-set:normal-printing)
+                 (not (eq? 'separator:space (char-general-category char)))
+                 (allowed-char? char context))
+            (*unparse-char char context)
+            (*unparse-string (char->name char) context)))
+       (else
+        (*unparse-char char context))))
 
 (define (unparse/string string context)
   (if (context-slashify? context)