Handle atom delimiters specially when they are the first character

after "#\".

diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index 757f7acf4fb8be66cff13df9d574aa35ca833ce0..28247abaf50e115321c2c418436423bdb211d83d 100644 (file)
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parse.scm,v 14.62 2006/06/21 02:57:28 cph Exp $
+$Id: parse.scm,v 14.63 2006/06/21 13:45:52 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1994,1997,1998,1999 Massachusetts Institute of Technology
@@ -497,24 +497,27 @@ USA.
 
 (define (handler:char port db ctx char1 char2)
   db ctx char1 char2
-  (name->char (read-char-name port)))
-
-(define (read-char-name port)
-  (call-with-output-string
-    (lambda (port*)
-      (let ((char (read-char/no-eof port)))
-       (write-char char port*)
-       (let loop ()
-         (let ((char (peek-char port)))
-           (if (not (or (eof-object? char)
-                        (atom-delimiter? char)))
-               (begin
-                 (discard-char port)
-                 (write-char (if (char=? char #\\)
-                                 (read-char/no-eof port)
-                                 char)
-                             port*)
-                 (loop)))))))))
+  (let ((char (read-char/no-eof port))
+       (at-end?
+        (lambda ()
+          (let ((char (peek-char port)))
+            (or (eof-object? char)
+                (atom-delimiter? char))))))
+    (if (or (atom-delimiter? char)
+           (at-end?))
+       char
+       (name->char
+        (call-with-output-string
+          (lambda (port*)
+            (write-char char port*)
+            (let loop ()
+              (write-char (let ((char (read-char/no-eof port)))
+                            (if (char=? char #\\)
+                                (read-char/no-eof port)
+                                char))
+                          port*)
+              (if (not (at-end?))
+                  (loop)))))))))
 \f
 (define (handler:named-constant port db ctx char1 char2)
   ctx char1 char2