X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-format.lisp;h=4cb042a696277eaa5db87c899b3c6ad45ad14b36;hb=dc9d03a1c43398d3a860520c6ea03e8d5838d142;hp=fef1acc2b4daf4bf0050e2457e0d326d76ac71fe;hpb=0b3acc2ba40b8f222e9279871af53e0afe89c969;p=sbcl.git

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index fef1acc..4cb042a 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -9,7 +9,7 @@
 
 (in-package "SB!FORMAT")
 
-(define-condition format-error (error)
+(define-condition format-error (error reference-condition)
   ((complaint :reader format-error-complaint :initarg :complaint)
    (args :reader format-error-args :initarg :args :initform nil)
    (control-string :reader format-error-control-string
@@ -21,7 +21,8 @@
                     :initarg :second-relative :initform nil)
    (print-banner :reader format-error-print-banner :initarg :print-banner
 		 :initform t))
-  (:report %print-format-error))
+  (:report %print-format-error)
+  (:default-initargs :references nil))
 
 (defun %print-format-error (condition stream)
   (format stream
@@ -38,7 +39,7 @@
   (string (missing-arg) :type simple-string)
   (start (missing-arg) :type (and unsigned-byte fixnum))
   (end (missing-arg) :type (and unsigned-byte fixnum))
-  (character (missing-arg) :type base-char)
+  (character (missing-arg) :type character)
   (colonp nil :type (member t nil))
   (atsignp nil :type (member t nil))
   (params nil :type list))
@@ -106,7 +107,8 @@
                :offset (min pprint-offset justification-offset)
                :second-relative (- (max pprint-offset justification-offset)
                                    (min pprint-offset justification-offset)
-                                   1))))
+                                   1)
+               :references (list '(:ansi-cl :section (22 3 5 2))))))
     (nreverse result)))
 
 (defun parse-directive (string start)
@@ -124,7 +126,8 @@
 	       (error 'format-error
 		      :complaint "parameters found after #\\: or #\\@ modifier"
 		      :control-string string
-		      :offset posn))))
+		      :offset posn
+                      :references (list '(:ansi-cl :section (22 3)))))))
       (loop
 	(let ((char (get-char)))
 	  (cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))
@@ -175,14 +178,16 @@
 		     (error 'format-error
 			    :complaint "too many colons supplied"
 			    :control-string string
-			    :offset posn)
+			    :offset posn
+                            :references (list '(:ansi-cl :section (22 3))))
 		     (setf colonp t)))
 		((char= char #\@)
 		 (if atsignp
 		     (error 'format-error
 			    :complaint "too many #\\@ characters supplied"
 			    :control-string string
-			    :offset posn)
+			    :offset posn
+                            :references (list '(:ansi-cl :section (22 3))))
 		     (setf atsignp t)))
 		(t
 		 (when (and (char= (schar string (1- posn)) #\,)
@@ -265,8 +270,11 @@
   (etypecase directive
     (format-directive
      (let ((expander
-	    (aref *format-directive-expanders*
-		  (char-code (format-directive-character directive))))
+            (let ((char (format-directive-character directive)))
+              (typecase char
+                (base-char
+                 (aref *format-directive-expanders* (char-code char)))
+                (character nil))))
 	   (*default-format-error-offset*
 	    (1- (format-directive-end directive))))
        (declare (type (or null function) expander))
@@ -680,7 +688,7 @@
 		 (setf args (nthcdr ,posn orig-args))
 		 (error 'format-error
 			:complaint "Index ~W out of bounds. Should have been ~
-				    between 0 and ~W."
+                                    between 0 and ~W."
 			:args (list ,posn (length orig-args))
 			:offset ,(1- end)))))
       (if colonp
@@ -697,7 +705,7 @@
 			(error 'format-error
 			       :complaint
 			       "Index ~W is out of bounds; should have been ~
-				between 0 and ~W."
+                                between 0 and ~W."
 			       :args (list new-posn (length orig-args))
 			       :offset ,(1- end)))))))
 	  (if params
@@ -1030,9 +1038,10 @@
 	     ;; situation.
 	     (error 'format-error
 		    :complaint "~D illegal directive~:P found inside justification block"
-		    :args (list count)))
+		    :args (list count)
+                    :references (list '(:ansi-cl :section (22 3 5 2)))))
 	   (expand-format-justification segments colonp atsignp
-				      first-semi params)))
+                                        first-semi params)))
      remaining)))
 
 (def-complex-format-directive #\> ()
@@ -1053,10 +1062,12 @@
 		   (if directive
 		       (error 'format-error
 			      :complaint
-			      "cannot include format directives inside the ~
-			       ~:[suffix~;prefix~] segment of ~~<...~~:>"
+                              "cannot include format directives inside the ~
+                               ~:[suffix~;prefix~] segment of ~~<...~~:>"
 			      :args (list prefix-p)
-			      :offset (1- (format-directive-end directive)))
+			      :offset (1- (format-directive-end directive))
+                              :references
+                              (list '(:ansi-cl :section (22 3 5 2))))
 		       (apply #'concatenate 'string list)))))
 	(case (length segments)
 	  (0 (values prefix-default nil suffix-default))
@@ -1366,7 +1377,7 @@
 			((char= c #\P)
 			 (unless (format-directive-colonp directive)
 			   (incf-both)))
-			((or (find c "IT%&|_();>") (char= c #\Newline)))
+			((or (find c "IT%&|_();>~") (char= c #\Newline)))
                         ;; FIXME: check correspondence of ~( and ~)
 			((char= c #\<)
 			 (walk-complex-directive walk-justification))