X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=4981c77f2e0a32f9b8354b5fb5531509e9b7e04b;hb=ec066d84dd46611428943d152749b3891a3f4b7c;hp=0989d83f57b80a43be260a1da2603a6eab236970;hpb=af296975b301138518c6088ac012818df39abf37;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 0989d83..4981c77 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -598,10 +598,11 @@
 ;;; READTABLE-CASE.
 (defun output-symbol-name (name stream &optional (maybe-quote t))
   (declare (type simple-string name))
-  (setup-printer-state)
-  (if (and maybe-quote (symbol-quotep name))
-      (output-quoted-symbol-name name stream)
-      (funcall *internal-symbol-output-fun* name stream)))
+  (let ((*readtable* (if *print-readably* *standard-readtable* *readtable*)))
+    (setup-printer-state)
+    (if (and maybe-quote (symbol-quotep name))
+	(output-quoted-symbol-name name stream)
+	(funcall *internal-symbol-output-fun* name stream))))
 
 ;;;; escaping symbols
 
@@ -875,19 +876,19 @@
 ;;; :DOWNCASE		:CAPITALIZE
 (defun output-capitalize-symbol (pname stream)
   (declare (simple-string pname))
-  (let ((prev-not-alpha t)
+  (let ((prev-not-alphanum t)
 	(up (eq (readtable-case *readtable*) :upcase)))
     (dotimes (i (length pname))
       (let ((char (char pname i)))
 	(write-char (if up
-			(if (or prev-not-alpha (lower-case-p char))
+			(if (or prev-not-alphanum (lower-case-p char))
 			    char
 			    (char-downcase char))
-			(if prev-not-alpha
+			(if prev-not-alphanum
 			    (char-upcase char)
 			    char))
 		    stream)
-	(setq prev-not-alpha (not (alpha-char-p char)))))))
+	(setq prev-not-alphanum (not (alphanumericp char)))))))
 
 ;;; called when:
 ;;; READTABLE-CASE	*PRINT-CASE*
@@ -1528,9 +1529,10 @@
 ;;; the character name or the character in the #\char format.
 (defun output-character (char stream)
   (if (or *print-escape* *print-readably*)
-      (let ((name (char-name char)))
+      (let ((graphicp (graphic-char-p char))
+	    (name (char-name char)))
 	(write-string "#\\" stream)
-	(if name
+	(if (and name (not graphicp))
 	    (quote-string name stream)
 	    (write-char char stream)))
       (write-char char stream)))