X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=df74380e35f2e42e23d7e22b9e980cc2375c472c;hb=b6ed0e20d468099b62d27095db7d18f76d8886d2;hp=91b83092db41129e2ead39e5258fed566e48068c;hpb=d6d76c98535bddabd73c6338f8393b6e698f297f;p=sbcl.git diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 91b8309..df74380 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -78,8 +78,7 @@ (function (typecase character (base-char - (svref *format-directive-interpreters* - (char-code character))) + (svref *format-directive-interpreters* (char-code character))) (character nil))) (*default-format-error-offset* (1- (format-directive-end directive)))) @@ -228,12 +227,16 @@ (prin1 (next-arg) stream) (write-char (next-arg) stream))))) +;;; "printing" as defined in the ANSI CL glossary, which is normative. +(defun char-printing-p (char) + (and (not (eql char #\Space)) + (graphic-char-p char))) + (defun format-print-named-character (char stream) - (let* ((name (char-name char))) - (cond (name - (write-string (string-capitalize name) stream)) - (t - (write-char char stream))))) + (cond ((not (char-printing-p char)) + (write-string (string-capitalize (char-name char)) stream)) + (t + (write-char char stream)))) (def-format-interpreter #\W (colonp atsignp params) (interpret-bind-defaults () params