X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=26616bcc5ce0fe1869b4f7101c5a6c7bdcdc8088;hb=0b96758f3645dff3e681d82cc97ddab1faae27ac;hp=38601324a1157779f4913ea61402bba962fbae04;hpb=1f0efb731e8427080690f8ecaf9a56fc287a9d88;p=sbcl.git

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 3860132..26616bc 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -76,8 +76,11 @@
 	   (multiple-value-bind (new-directives new-args)
 	       (let* ((character (format-directive-character directive))
 		      (function
+                       (typecase character
+                         (base-char 
 		       (svref *format-directive-interpreters*
 			      (char-code character)))
+                         (character nil)))
 		      (*default-format-error-offset*
 		       (1- (format-directive-end directive))))
 		 (unless function
@@ -835,7 +838,7 @@
 		(setf args (nthcdr posn orig-args))
 		(error 'format-error
 		       :complaint "Index ~W is out of bounds. (It should ~
-				   have been between 0 and ~W.)"
+                                   have been between 0 and ~W.)"
 		       :args (list posn (length orig-args))))))
       (if colonp
 	  (interpret-bind-defaults ((n 1)) params
@@ -848,7 +851,7 @@
 		       (error 'format-error
 			      :complaint
 			      "Index ~W is out of bounds. (It should 
-			       have been between 0 and ~W.)"
+                               have been between 0 and ~W.)"
 			      :args
 			      (list new-posn (length orig-args))))))))
 	  (interpret-bind-defaults ((n 1)) params
@@ -1113,8 +1116,6 @@
 (defun format-justification (stream newline-prefix extra-space line-len strings
 			     pad-left pad-right mincol colinc minpad padchar)
   (setf strings (reverse strings))
-  (when (and (not pad-left) (not pad-right) (null (cdr strings)))
-    (setf pad-left t))
   (let* ((num-gaps (+ (1- (length strings))
 		      (if pad-left 1 0)
 		      (if pad-right 1 0)))
@@ -1125,18 +1126,19 @@
 	 (length (if (> chars mincol)
 		     (+ mincol (* (ceiling (- chars mincol) colinc) colinc))
 		     mincol))
-	 (padding (- length chars)))
+	 (padding (+ (- length chars) (* num-gaps minpad))))
     (when (and newline-prefix
 	       (> (+ (or (sb!impl::charpos stream) 0)
 		     length extra-space)
 		  line-len))
       (write-string newline-prefix stream))
     (flet ((do-padding ()
-	     (let ((pad-len (truncate padding num-gaps)))
+	     (let ((pad-len
+                    (if (zerop num-gaps) padding (truncate padding num-gaps))))
 	       (decf padding pad-len)
 	       (decf num-gaps)
 	       (dotimes (i pad-len) (write-char padchar stream)))))
-      (when pad-left
+      (when (or pad-left (and (not pad-right) (null (cdr strings))))
 	(do-padding))
       (when strings
 	(write-string (car strings) stream)