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.
12 (if (typep x 'generic-function)
13 (slot-value x '%documentation)
16 (defun (setf fun-doc) (new-value x)
17 (if (typep x 'generic-function)
18 (setf (slot-value x '%documentation) new-value)
19 (setf (%fun-doc x) new-value)))
21 ;;; functions, macros, and special forms
22 (defmethod documentation ((x function) (doc-type (eql 't)))
25 (defmethod documentation ((x function) (doc-type (eql 'function)))
28 (defmethod documentation ((x list) (doc-type (eql 'function)))
29 (when (and (legal-fun-name-p x) (fboundp x))
30 (fun-doc (fdefinition x))))
32 (defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
33 (awhen (compiler-macro-function x)
34 (documentation it t)))
36 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
37 (when (and (legal-fun-name-p x) (fboundp x))
38 (fun-doc (or (macro-function x) (fdefinition x)))))
40 (defmethod documentation ((x symbol) (doc-type (eql 'compiler-macro)))
41 (awhen (compiler-macro-function x)
42 (documentation it t)))
44 (defmethod documentation ((x symbol) (doc-type (eql 'setf)))
45 (fdocumentation x 'setf))
47 (defmethod documentation ((x symbol) (doc-type (eql 'optimize)))
48 (random-documentation x 'optimize))
50 (defmethod (setf documentation) (new-value (x function) (doc-type (eql 't)))
51 (setf (fun-doc x) new-value))
53 (defmethod (setf documentation) (new-value (x function) (doc-type (eql 'function)))
54 (setf (fun-doc x) new-value))
56 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
57 (when (and (legal-fun-name-p x) (fboundp x))
58 (setf (documentation (fdefinition x) t) new-value)))
60 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'compiler-macro)))
61 (awhen (compiler-macro-function x)
62 (setf (documentation it t) new-value)))
64 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
65 (when (and (legal-fun-name-p x) (fboundp x))
66 (setf (documentation (or (macro-function x) (symbol-function x)) t)
69 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'compiler-macro)))
70 (awhen (compiler-macro-function x)
71 (setf (documentation it t) new-value)))
73 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
74 (setf (fdocumentation x 'setf) new-value))
76 ;;; method combinations
77 (defmethod documentation ((x method-combination) (doc-type (eql 't)))
78 (slot-value x '%documentation))
80 (defmethod documentation
81 ((x method-combination) (doc-type (eql 'method-combination)))
82 (slot-value x '%documentation))
84 (defmethod documentation ((x symbol) (doc-type (eql 'method-combination)))
85 (random-documentation x 'method-combination))
87 (defmethod (setf documentation)
88 (new-value (x method-combination) (doc-type (eql 't)))
89 (setf (slot-value x '%documentation) new-value))
91 (defmethod (setf documentation)
92 (new-value (x method-combination) (doc-type (eql 'method-combination)))
93 (setf (slot-value x '%documentation) new-value))
95 (defmethod (setf documentation)
96 (new-value (x symbol) (doc-type (eql 'method-combination)))
97 (setf (random-documentation x 'method-combination) new-value))
100 (defmethod documentation ((x standard-method) (doc-type (eql 't)))
101 (slot-value x '%documentation))
103 (defmethod (setf documentation)
104 (new-value (x standard-method) (doc-type (eql 't)))
105 (setf (slot-value x '%documentation) new-value))
109 ;;; KLUDGE: It's nasty having things like this accessor
110 ;;; (PACKAGE-DOC-STRING) floating around out in this mostly-unrelated
111 ;;; source file. Perhaps it would be better to support WARM-INIT-FORMS
112 ;;; by analogy with the existing !COLD-INIT-FORMS and have them be
113 ;;; EVAL'ed after basic warm load is done? That way things like this
114 ;;; could be defined alongside the other code which does low-level
115 ;;; hacking of packages.. -- WHN 19991203
117 (defmethod documentation ((x package) (doc-type (eql 't)))
118 (package-doc-string x))
120 (defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
121 (setf (package-doc-string x) new-value))
123 ;;; types, classes, and structure names
124 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
125 (fdocumentation (class-name x) 'type))
127 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
128 (fdocumentation (class-name x) 'type))
130 (defmethod documentation ((x standard-class) (doc-type (eql 't)))
131 (slot-value x '%documentation))
133 (defmethod documentation ((x standard-class) (doc-type (eql 'type)))
134 (slot-value x '%documentation))
136 ;;; although the CLHS doesn't mention this, it is reasonable to assume
137 ;;; that parallel treatment of condition-class was intended (if
138 ;;; condition-class is in fact not implemented as a standard-class or
139 ;;; structure-class).
140 (defmethod documentation ((x condition-class) (doc-type (eql 't)))
141 (fdocumentation (class-name x) 'type))
143 (defmethod documentation ((x condition-class) (doc-type (eql 'type)))
144 (fdocumentation (class-name x) 'type))
146 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
147 (or (fdocumentation x 'type)
148 (let ((class (find-class x nil)))
150 (slot-value class '%documentation)))))
152 (defmethod documentation ((x symbol) (doc-type (eql 'structure)))
153 (fdocumentation x 'structure))
155 (defmethod (setf documentation) (new-value
158 (setf (fdocumentation (class-name x) 'type) new-value))
160 (defmethod (setf documentation) (new-value
162 (doc-type (eql 'type)))
163 (setf (fdocumentation (class-name x) 'type) new-value))
165 (defmethod (setf documentation) (new-value
168 (setf (slot-value x '%documentation) new-value))
170 (defmethod (setf documentation) (new-value
172 (doc-type (eql 'type)))
173 (setf (slot-value x '%documentation) new-value))
175 (defmethod (setf documentation) (new-value
178 (setf (fdocumentation (class-name x) 'type) new-value))
180 (defmethod (setf documentation) (new-value
182 (doc-type (eql 'type)))
183 (setf (fdocumentation (class-name x) 'type) new-value))
185 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
186 (if (or (structure-type-p x) (condition-type-p x))
187 (setf (fdocumentation x 'type) new-value)
188 (let ((class (find-class x nil)))
190 (setf (slot-value class '%documentation) new-value)
191 (setf (fdocumentation x 'type) new-value)))))
193 (defmethod (setf documentation) (new-value
195 (doc-type (eql 'structure)))
196 (setf (fdocumentation x 'structure) new-value))
199 (defmethod documentation ((x symbol) (doc-type (eql 'variable)))
200 (fdocumentation x 'variable))
202 (defmethod (setf documentation) (new-value
204 (doc-type (eql 'variable)))
205 (setf (fdocumentation x 'variable) new-value))
207 ;;; default if DOC-TYPE doesn't match one of the specified types
208 (defmethod documentation (object doc-type)
209 (warn "unsupported DOCUMENTATION: type ~S for object of type ~S"
214 ;;; default if DOC-TYPE doesn't match one of the specified types
215 (defmethod (setf documentation) (new-value object doc-type)
216 ;; CMU CL made this an error, but since ANSI says that even for supported
217 ;; doc types an implementation is permitted to discard docs at any time
218 ;; for any reason, this feels to me more like a warning. -- WHN 19991214
219 (warn "discarding unsupported DOCUMENTATION of type ~S for object ~S"
224 ;;; extra-standard methods, for getting at slot documentation
225 (defmethod documentation ((slotd standard-slot-definition) (doc-type (eql 't)))
226 (declare (ignore doc-type))
227 (slot-value slotd '%documentation))
229 (defmethod (setf documentation)
230 (new-value (slotd standard-slot-definition) (doc-type (eql 't)))
231 (declare (ignore doc-type))
232 (setf (slot-value slotd '%documentation) new-value))
234 ;;; Now that we have created the machinery for setting documentation, we can
235 ;;; set the documentation for the machinery for setting documentation.
237 (setf (documentation 'documentation 'function)
238 "Return the documentation string of Doc-Type for X, or NIL if
239 none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,