[Sbcl-commits] CVS: sbcl/src/code condition.lisp,1.58,1.59 sharpm.lisp,1.13,1.14

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5503/src/code

Modified Files:
	condition.lisp sharpm.lisp 
Log Message:
0.8.19.32:
	In response to a question on #lisp IRC...
	... make the style-warning for #S(FOO #\A 1) include a reference
		to the relevant section in CLtS.


Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- condition.lisp	13 Feb 2005 14:27:07 -0000	1.58
+++ condition.lisp	18 Feb 2005 08:22:28 -0000	1.59
@@ -913,6 +913,11 @@
 (define-condition extension-failure (reference-condition simple-error)
   ())
 
+(define-condition structure-initarg-not-keyword
+    (reference-condition simple-style-warning)
+  ()
+  (:default-initargs :references (list '(:ansi-cl :section (2 4 8 13)))))
+
 #!+sb-package-locks
 (progn
 

Index: sharpm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sharpm.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- sharpm.lisp	31 Jan 2005 19:25:38 -0000	1.13
+++ sharpm.lisp	18 Feb 2005 08:22:29 -0000	1.14
@@ -159,9 +159,12 @@
                               designator: ~S."
 			     slot-name))
 			  (when (not (keywordp slot-name))
-			    (style-warn "in #S ~S, the use of non-keywords ~
-                                         as slot specifiers is deprecated: ~S."
-					(car body) slot-name)))
+                            (warn 'structure-initarg-not-keyword
+                                  :format-control
+                                  "in #S ~S, the use of non-keywords ~
+                                   as slot specifiers is deprecated: ~S."
+                                  :format-arguments
+                                  (list (car body) slot-name))))
 		     collect (intern (string (car tail)) *keyword-package*)
 		     collect (cadr tail)))))))