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.
11 ;;; FIXME: Lots of bare calls to INFO here could be handled
12 ;;; more cleanly by calling the FDOCUMENTATION function instead.
17 (slot-value x '%documentation))
19 (sb-eval:interpreted-function
20 (sb-eval:interpreted-function-documentation x))
24 ;;; functions, macros, and special forms
25 (defmethod documentation ((x function) (doc-type (eql 't)))
28 (defmethod documentation ((x function) (doc-type (eql 'function)))
31 (defmethod documentation ((x list) (doc-type (eql 'function)))
32 (and (legal-fun-name-p x)
34 (documentation (fdefinition x) t)))
36 (defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
37 (random-documentation x 'compiler-macro))
39 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
40 (or (values (info :function :documentation x))
41 ;; Try the pcl function documentation.
42 (and (fboundp x) (documentation (fdefinition x) t))))
44 (defmethod documentation ((x symbol) (doc-type (eql 'compiler-macro)))
45 (random-documentation x 'compiler-macro))
47 (defmethod documentation ((x symbol) (doc-type (eql 'setf)))
48 (values (info :setf :documentation x)))
50 (defmethod documentation ((x symbol) (doc-type (eql 'optimize)))
51 (random-documentation x 'optimize))
53 (defun (setf fun-doc) (new-value x)
56 (setf (slot-value x '%documentation) new-value))
58 (sb-eval:interpreted-function
59 (setf (sb-eval:interpreted-function-documentation x)
62 (let ((name (%fun-name x)))
63 (when (and name (typep name '(or symbol cons)))
64 (setf (info :function :documentation name) new-value)))))
68 (defmethod (setf documentation) (new-value (x function) (doc-type (eql 't)))
69 (setf (fun-doc x) new-value))
71 (defmethod (setf documentation) (new-value
73 (doc-type (eql 'function)))
74 (setf (fun-doc x) new-value))
76 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
77 (setf (info :function :documentation x) new-value))
79 (defmethod (setf documentation)
80 (new-value (x list) (doc-type (eql 'compiler-macro)))
81 (setf (random-documentation x 'compiler-macro) new-value))
83 (defmethod (setf documentation) (new-value
85 (doc-type (eql 'function)))
86 (setf (info :function :documentation x) new-value))
88 (defmethod (setf documentation)
89 (new-value (x symbol) (doc-type (eql 'compiler-macro)))
90 (setf (random-documentation x 'compiler-macro) new-value))
92 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
93 (setf (info :setf :documentation x) new-value))
95 ;;; method combinations
96 (defmethod documentation ((x method-combination) (doc-type (eql 't)))
97 (slot-value x '%documentation))
99 (defmethod documentation
100 ((x method-combination) (doc-type (eql 'method-combination)))
101 (slot-value x '%documentation))
103 (defmethod documentation ((x symbol) (doc-type (eql 'method-combination)))
104 (random-documentation x 'method-combination))
106 (defmethod (setf documentation)
107 (new-value (x method-combination) (doc-type (eql 't)))
108 (setf (slot-value x '%documentation) new-value))
110 (defmethod (setf documentation)
111 (new-value (x method-combination) (doc-type (eql 'method-combination)))
112 (setf (slot-value x '%documentation) new-value))
114 (defmethod (setf documentation)
115 (new-value (x symbol) (doc-type (eql 'method-combination)))
116 (setf (random-documentation x 'method-combination) new-value))
119 (defmethod documentation ((x standard-method) (doc-type (eql 't)))
120 (slot-value x '%documentation))
122 (defmethod (setf documentation)
123 (new-value (x standard-method) (doc-type (eql 't)))
124 (setf (slot-value x '%documentation) new-value))
128 ;;; KLUDGE: It's nasty having things like this accessor
129 ;;; (PACKAGE-DOC-STRING) floating around out in this mostly-unrelated
130 ;;; source file. Perhaps it would be better to support WARM-INIT-FORMS
131 ;;; by analogy with the existing !COLD-INIT-FORMS and have them be
132 ;;; EVAL'ed after basic warm load is done? That way things like this
133 ;;; could be defined alongside the other code which does low-level
134 ;;; hacking of packages.. -- WHN 19991203
136 (defmethod documentation ((x package) (doc-type (eql 't)))
137 (package-doc-string x))
139 (defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
140 (setf (package-doc-string x) new-value))
142 ;;; types, classes, and structure names
143 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
144 (values (info :type :documentation (class-name x))))
146 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
147 (values (info :type :documentation (class-name x))))
149 (defmethod documentation ((x standard-class) (doc-type (eql 't)))
150 (slot-value x '%documentation))
152 (defmethod documentation ((x standard-class) (doc-type (eql 'type)))
153 (slot-value x '%documentation))
155 ;;; although the CLHS doesn't mention this, it is reasonable to assume
156 ;;; that parallel treatment of condition-class was intended (if
157 ;;; condition-class is in fact not implemented as a standard-class or
158 ;;; structure-class).
159 (defmethod documentation ((x condition-class) (doc-type (eql 't)))
160 (values (info :type :documentation (class-name x))))
162 (defmethod documentation ((x condition-class) (doc-type (eql 'type)))
163 (values (info :type :documentation (class-name x))))
165 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
166 (or (values (info :type :documentation x))
167 (let ((class (find-class x nil)))
169 (slot-value class '%documentation)))))
171 (defmethod documentation ((x symbol) (doc-type (eql 'structure)))
173 ((structure-type-p x)
174 (values (info :type :documentation x)))
175 ((info :typed-structure :info x)
176 (values (info :typed-structure :documentation x)))
179 (defmethod (setf documentation) (new-value
182 (setf (info :type :documentation (class-name x)) new-value))
184 (defmethod (setf documentation) (new-value
186 (doc-type (eql 'type)))
187 (setf (info :type :documentation (class-name x)) new-value))
189 (defmethod (setf documentation) (new-value
192 (setf (slot-value x '%documentation) new-value))
194 (defmethod (setf documentation) (new-value
196 (doc-type (eql 'type)))
197 (setf (slot-value x '%documentation) new-value))
199 (defmethod (setf documentation) (new-value
202 (setf (info :type :documentation (class-name x)) new-value))
204 (defmethod (setf documentation) (new-value
206 (doc-type (eql 'type)))
207 (setf (info :type :documentation (class-name x)) new-value))
209 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
210 (if (or (structure-type-p x) (condition-type-p x))
211 (setf (info :type :documentation x) new-value)
212 (let ((class (find-class x nil)))
214 (setf (slot-value class '%documentation) new-value)
215 (setf (info :type :documentation x) new-value)))))
217 (defmethod (setf documentation) (new-value
219 (doc-type (eql 'structure)))
221 ((structure-type-p x)
222 (setf (info :type :documentation x) new-value))
223 ((info :typed-structure :info x)
224 (setf (info :typed-structure :documentation x) new-value))
228 (defmethod documentation ((x symbol) (doc-type (eql 'variable)))
229 (values (info :variable :documentation x)))
231 (defmethod (setf documentation) (new-value
233 (doc-type (eql 'variable)))
234 (setf (info :variable :documentation x) new-value))
236 ;;; default if DOC-TYPE doesn't match one of the specified types
237 (defmethod documentation (object doc-type)
238 (warn "unsupported DOCUMENTATION: type ~S for object ~S"
243 ;;; default if DOC-TYPE doesn't match one of the specified types
244 (defmethod (setf documentation) (new-value object doc-type)
245 ;; CMU CL made this an error, but since ANSI says that even for supported
246 ;; doc types an implementation is permitted to discard docs at any time
247 ;; for any reason, this feels to me more like a warning. -- WHN 19991214
248 (warn "discarding unsupported DOCUMENTATION of type ~S for object ~S"
253 ;;; extra-standard methods, for getting at slot documentation
254 (defmethod documentation ((slotd standard-slot-definition) (doc-type (eql 't)))
255 (declare (ignore doc-type))
256 (slot-value slotd '%documentation))
258 (defmethod (setf documentation)
259 (new-value (slotd standard-slot-definition) (doc-type (eql 't)))
260 (declare (ignore doc-type))
261 (setf (slot-value slotd '%documentation) new-value))
263 ;;; Now that we have created the machinery for setting documentation, we can
264 ;;; set the documentation for the machinery for setting documentation.
266 (setf (documentation 'documentation 'function)
267 "Return the documentation string of Doc-Type for X, or NIL if
268 none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,