From: Christophe R. <cr...@us...> - 2006-04-07 11:41:54
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4127/src/pcl Modified Files: documentation.lisp Log Message: 0.9.11.18: After Gary King (sbcl-devel 2006-04-06), improve DOCUMENTATION on condition classes. ... also improve the 'STRUCTURE doc-type. ... tests. Index: documentation.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/documentation.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- documentation.lisp 13 Feb 2006 15:59:16 -0000 1.14 +++ documentation.lisp 7 Apr 2006 11:41:47 -0000 1.15 @@ -137,6 +137,16 @@ (defmethod documentation ((x standard-class) (doc-type (eql 'type))) (slot-value x '%documentation)) +;;; although the CLHS doesn't mention this, it is reasonable to assume +;;; that parallel treatment of condition-class was intended (if +;;; condition-class is in fact not implemented as a standard-class or +;;; structure-class). +(defmethod documentation ((x condition-class) (doc-type (eql 't))) + (values (info :type :documentation (class-name x)))) + +(defmethod documentation ((x condition-class) (doc-type (eql 'type))) + (values (info :type :documentation (class-name x)))) + (defmethod documentation ((x symbol) (doc-type (eql 'type))) (or (values (info :type :documentation x)) (let ((class (find-class x nil))) @@ -144,12 +154,12 @@ (slot-value class '%documentation))))) (defmethod documentation ((x symbol) (doc-type (eql 'structure))) - (cond ((eq (info :type :kind x) :instance) - (values (info :type :documentation x))) - ((info :typed-structure :info x) - (values (info :typed-structure :documentation x))) - (t - nil))) + (cond + ((structure-type-p x) + (values (info :type :documentation x))) + ((info :typed-structure :info x) + (values (info :typed-structure :documentation x))) + (t nil))) (defmethod (setf documentation) (new-value (x structure-class) @@ -171,6 +181,16 @@ (doc-type (eql 'type))) (setf (slot-value x '%documentation) new-value)) +(defmethod (setf documentation) (new-value + (x condition-class) + (doc-type (eql 't))) + (setf (info :type :documentation (class-name x)) new-value)) + +(defmethod (setf documentation) (new-value + (x condition-class) + (doc-type (eql 'type))) + (setf (info :type :documentation (class-name x)) new-value)) + (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type))) (if (or (structure-type-p x) (condition-type-p x)) (setf (info :type :documentation x) new-value) @@ -182,13 +202,12 @@ (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'structure))) - (cond ((eq (info :type :kind x) :instance) - (setf (info :type :documentation x) new-value)) - ((info :typed-structure :info x) - (setf (info :typed-structure :documentation x) new-value)) - (t - nil))) - + (cond + ((structure-type-p x) + (setf (info :type :documentation x) new-value)) + ((info :typed-structure :info x) + (setf (info :typed-structure :documentation x) new-value)) + (t new-value))) ;;; variables (defmethod documentation ((x symbol) (doc-type (eql 'variable))) |