From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 29 Jan 2017 08:50:20 +0000 (-0800)
Subject: Implement #\x... syntax for characters.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~33
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=24b62a216ffaf165e50cf6c0fe3f6619927672be;p=mit-scheme.git

Implement #\x... syntax for characters.
---

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 18772031e..3d89aa3b2 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -235,7 +235,11 @@ USA.
 		 (loop (fix:+ hyphen 1) (fix:or bit bits)))
 	       (make-char
 		(or (->code named-codes string start end)
-		    (and (substring-prefix-ci? "U+" 0 1 string start end)
+		    ;; R7RS syntax:
+		    (and (substring-prefix-ci? "x" 0 1 string start end)
+			 (substring->number string (fix:+ start 1) end 16))
+		    ;; Non-standard Unicode-style syntax:
+		    (and (substring-prefix-ci? "u+" 0 2 string start end)
 			 (substring->number string (fix:+ start 2) end 16))
 		    (lose))
 		bits))))))))
@@ -255,15 +259,7 @@ USA.
 	     ((char-graphic? base-char)
 	      (string base-char))
 	     (else
-	      (string-append "U+"
-			     (let ((s (number->string code 16)))
-			       (string-pad-left s
-						(let ((l (string-length s)))
-						  (let loop ((n 2))
-						    (if (fix:<= l n)
-							n
-							(loop (fix:* 2 n)))))
-						#\0)))))))))
+	      (string-append "x" (number->string code 16))))))))
 
 ;; This procedure used by Edwin.
 (define (bucky-bits->prefix bits)