1 ;;;; implementation of CL:DOCUMENTATION
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is in the public domain and is provided with absolutely no
7 ;;;; warranty. See the COPYING and CREDITS files for more information.
14 ;;; Note some cases are handled by the documentation methods in
16 ;;; FIXME: Those should probably be moved into this file too.
18 ;;; FIXME: Lots of bare calls to INFO here could be handled
19 ;;; more cleanly by calling the FDOCUMENTATION function instead.
21 ;;; FIXME: Neither SBCL nor Debian CMU CL 2.4.17 handles
23 ;;; (SETF (DOCUMENTATION #'FOO 'FUNCTION) "testing")
25 ;;; Can't change the documentation of #<interpreted function FOO {900BF51}>.
26 ;;; The coverage of the DOCUMENTATION methods ought to be systematically
27 ;;; compared to the ANSI specification of DOCUMENTATION.
29 ;;; functions, macros, and special forms
30 (defmethod documentation ((x function) (doc-type (eql 't)))
31 (sb-impl::function-doc x))
33 (defmethod documentation ((x function) (doc-type (eql 'function)))
34 (sb-impl::function-doc x))
36 (defmethod documentation ((x list) (doc-type (eql 'function)))
37 ;; FIXME: could test harder to see whether it's a SETF function name,
39 (when (eq (first x) 'setf) ; Give up if not a setf function name.
40 (or (values (sb-int:info :setf :documentation (second x)))
41 ;; Try the pcl function documentation.
42 (and (fboundp x) (documentation (fdefinition x) 't)))))
44 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
45 (or (values (sb-int:info :function :documentation x))
46 ;; Try the pcl function documentation.
47 (and (fboundp x) (documentation (fdefinition x) 't))))
49 (defmethod documentation ((x symbol) (doc-type (eql 'setf)))
50 (values (sb-int:info :setf :documentation x)))
52 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
53 (setf (sb-int:info :setf :documentation (cadr x)) new-value))
55 (defmethod (setf documentation) (new-value
57 (doc-type (eql 'function)))
58 (setf (sb-int:info :function :documentation x) new-value))
60 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
61 (setf (sb-int:info :setf :documentation x) new-value))
64 (defmethod documentation ((x package) (doc-type (eql 't)))
65 (sb-impl::package-doc-string x))
67 (defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
68 (setf (sb-impl::package-doc-string x) new-value))
69 ;;; KLUDGE: It's nasty having things like this accessor floating around
70 ;;; out in this mostly-unrelated source file. Perhaps it would be
71 ;;; better to support WARM-INIT-FORMS by analogy with the existing
72 ;;; !COLD-INIT-FORMS and have them be EVAL'ed after basic warm load is
73 ;;; done? That way things like this could be defined alongside the
74 ;;; other code which does low-level hacking of packages.. -- WHN 19991203
76 ;;; types, classes, and structure names
77 (defmethod documentation ((x cl:structure-class) (doc-type (eql 't)))
78 (values (sb-int:info :type :documentation (cl:class-name x))))
80 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
81 (values (sb-int:info :type :documentation (class-name x))))
83 (defmethod documentation ((x cl:standard-class) (doc-type (eql 't)))
84 (or (values (sb-int:info :type :documentation (cl:class-name x)))
85 (let ((pcl-class (sb-kernel:class-pcl-class x)))
86 (and pcl-class (plist-value pcl-class 'documentation)))))
88 (defmethod documentation ((x cl:structure-class) (doc-type (eql 'type)))
89 (values (sb-int:info :type :documentation (cl:class-name x))))
91 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
92 (values (sb-int:info :type :documentation (class-name x))))
94 (defmethod documentation ((x cl:standard-class) (doc-type (eql 'type)))
95 (or (values (sb-int:info :type :documentation (cl:class-name x)))
96 (let ((pcl-class (sb-kernel:class-pcl-class x)))
97 (and pcl-class (plist-value pcl-class 'documentation)))))
99 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
100 (or (values (sb-int:info :type :documentation x))
101 (let ((class (find-class x nil)))
103 (plist-value class 'documentation)))))
105 (defmethod documentation ((x symbol) (doc-type (eql 'structure)))
106 (when (eq (sb-int:info :type :kind x) :instance)
107 (values (sb-int:info :type :documentation x))))
109 (defmethod (setf documentation) (new-value
110 (x cl:structure-class)
112 (setf (sb-int:info :type :documentation (cl:class-name x)) new-value))
114 (defmethod (setf documentation) (new-value
117 (setf (sb-int:info :type :documentation (class-name x)) new-value))
119 (defmethod (setf documentation) (new-value
120 (x cl:structure-class)
121 (doc-type (eql 'type)))
122 (setf (sb-int:info :type :documentation (cl:class-name x)) new-value))
124 (defmethod (setf documentation) (new-value
126 (doc-type (eql 'type)))
127 (setf (sb-int:info :type :documentation (class-name x)) new-value))
129 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
130 (if (structure-type-p x) ; Catch structures first.
131 (setf (sb-int:info :type :documentation x) new-value)
132 (let ((class (find-class x nil)))
134 (setf (plist-value class 'documentation) new-value)
135 (setf (sb-int:info :type :documentation x) new-value)))))
137 (defmethod (setf documentation) (new-value
139 (doc-type (eql 'structure)))
140 (unless (eq (sb-int:info :type :kind x) :instance)
141 (error "~S is not the name of a structure type." x))
142 (setf (sb-int:info :type :documentation x) new-value))
145 (defmethod documentation ((x symbol) (doc-type (eql 'variable)))
146 (values (sb-int:info :variable :documentation x)))
148 (defmethod (setf documentation) (new-value
150 (doc-type (eql 'variable)))
151 (setf (sb-int:info :variable :documentation x) new-value))
153 ;;; miscellaneous documentation. Compiler-macro documentation is stored
154 ;;; as random-documentation and handled here.
155 (defmethod documentation ((x symbol) (doc-type symbol))
157 (values (sb-int:info :random-documentation :stuff x)))))
159 (defmethod (setf documentation) (new-value (x symbol) (doc-type symbol))
160 (let ((pair (assoc doc-type (sb-int:info :random-documentation :stuff x))))
162 (setf (cdr pair) new-value)
163 (push (cons doc-type new-value)
164 (sb-int:info :random-documentation :stuff x))))
167 ;;; FIXME: The ((X SYMBOL) (DOC-TYPE SYMBOL)) method and its setf method should
168 ;;; have parallel versions which accept LIST-valued X arguments (for function
169 ;;; names in the (SETF FOO) style).
171 ;;; Now that we have created the machinery for setting documentation, we can
172 ;;; set the documentation for the machinery for setting documentation.
174 (setf (documentation 'documentation 'function)
175 "Return the documentation string of Doc-Type for X, or NIL if
176 none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,