src/pcl/documentation.lisp

   1 ;;;; implementation of CL:DOCUMENTATION
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5
   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.
   8
   9 (in-package "SB-PCL")
  10
  11 ;;; Note some cases are handled by the documentation methods in
  12 ;;; std-class.lisp.
  13 ;;; FIXME: Those should probably be moved into this file too.
  14
  15 ;;; FIXME: Lots of bare calls to INFO here could be handled
  16 ;;; more cleanly by calling the FDOCUMENTATION function instead.
  17
  18 ;;; FIXME: Neither SBCL nor Debian CMU CL 2.4.17 handles
  19 ;;;   (DEFUN FOO ())
  20 ;;;   (SETF (DOCUMENTATION #'FOO 'FUNCTION) "testing")
  21 ;;; They fail with
  22 ;;;   Can't change the documentation of #<interpreted function FOO {900BF51}>.
  23 ;;; The coverage of the DOCUMENTATION methods ought to be systematically
  24 ;;; compared to the ANSI specification of DOCUMENTATION.
  25
  26 ;;; functions, macros, and special forms
  27 (defmethod documentation ((x function) (doc-type (eql 't)))
  28   (%fun-doc x))
  29
  30 (defmethod documentation ((x function) (doc-type (eql 'function)))
  31   (%fun-doc x))
  32
  33 (defmethod documentation ((x list) (doc-type (eql 'function)))
  34   ;; FIXME: could test harder to see whether it's a SETF function name,
  35   ;; then call WARN
  36   (when (eq (first x) 'setf)    ; Give up if not a setf function name.
  37     (or (values (info :setf :documentation (second x)))
  38         ;; Try the pcl function documentation.
  39         (and (fboundp x) (documentation (fdefinition x) t)))))
  40
  41 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
  42   (or (values (info :function :documentation x))
  43       ;; Try the pcl function documentation.
  44       (and (fboundp x) (documentation (fdefinition x) t))))
  45
  46 (defmethod documentation ((x symbol) (doc-type (eql 'setf)))
  47   (values (info :setf :documentation x)))
  48
  49 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
  50   (setf (info :setf :documentation (cadr x)) new-value))
  51
  52 (defmethod (setf documentation) (new-value
  53                                  (x symbol)
  54                                  (doc-type (eql 'function)))
  55   (setf (info :function :documentation x) new-value))
  56
  57 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
  58   (setf (info :setf :documentation x) new-value))
  59
  60 ;;; packages
  61 (defmethod documentation ((x package) (doc-type (eql 't)))
  62   (package-doc-string x))
  63
  64 (defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
  65   (setf (package-doc-string x) new-value))
  66 ;;; KLUDGE: It's nasty having things like this accessor floating around
  67 ;;; out in this mostly-unrelated source file. Perhaps it would be
  68 ;;; better to support WARM-INIT-FORMS by analogy with the existing
  69 ;;; !COLD-INIT-FORMS and have them be EVAL'ed after basic warm load is
  70 ;;; done? That way things like this could be defined alongside the
  71 ;;; other code which does low-level hacking of packages.. -- WHN 19991203
  72
  73 ;;; types, classes, and structure names
  74 (defmethod documentation ((x cl:structure-class) (doc-type (eql 't)))
  75   (values (info :type :documentation (cl:class-name x))))
  76
  77 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
  78   (values (info :type :documentation (class-name x))))
  79
  80 (defmethod documentation ((x cl:standard-class) (doc-type (eql 't)))
  81   (or (values (info :type :documentation (cl:class-name x)))
  82       (let ((pcl-class (sb-kernel:class-pcl-class x)))
  83         (and pcl-class (plist-value pcl-class 'documentation)))))
  84
  85 (defmethod documentation ((x cl:structure-class) (doc-type (eql 'type)))
  86   (values (info :type :documentation (cl:class-name x))))
  87
  88 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
  89   (values (info :type :documentation (class-name x))))
  90
  91 (defmethod documentation ((x cl:standard-class) (doc-type (eql 'type)))
  92   (or (values (info :type :documentation (cl:class-name x)))
  93       (let ((pcl-class (sb-kernel:class-pcl-class x)))
  94         (and pcl-class (plist-value pcl-class 'documentation)))))
  95
  96 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
  97   (or (values (info :type :documentation x))
  98       (let ((class (find-class x nil)))
  99         (when class
 100           (plist-value class 'documentation)))))
 101
 102 (defmethod documentation ((x symbol) (doc-type (eql 'structure)))
 103   (when (eq (info :type :kind x) :instance)
 104     (values (info :type :documentation x))))
 105
 106 (defmethod (setf documentation) (new-value
 107                                  (x cl:structure-class)
 108                                  (doc-type (eql 't)))
 109   (setf (info :type :documentation (cl:class-name x)) new-value))
 110
 111 (defmethod (setf documentation) (new-value
 112                                  (x structure-class)
 113                                  (doc-type (eql 't)))
 114   (setf (info :type :documentation (class-name x)) new-value))
 115
 116 (defmethod (setf documentation) (new-value
 117                                  (x cl:structure-class)
 118                                  (doc-type (eql 'type)))
 119   (setf (info :type :documentation (cl:class-name x)) new-value))
 120
 121 (defmethod (setf documentation) (new-value
 122                                  (x structure-class)
 123                                  (doc-type (eql 'type)))
 124   (setf (info :type :documentation (class-name x)) new-value))
 125
 126 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
 127   (if (structure-type-p x)      ; Catch structures first.
 128       (setf (info :type :documentation x) new-value)
 129       (let ((class (find-class x nil)))
 130         (if class
 131             (setf (plist-value class 'documentation) new-value)
 132             (setf (info :type :documentation x) new-value)))))
 133
 134 (defmethod (setf documentation) (new-value
 135                                  (x symbol)
 136                                  (doc-type (eql 'structure)))
 137   (unless (eq (info :type :kind x) :instance)
 138     (error "~S is not the name of a structure type." x))
 139   (setf (info :type :documentation x) new-value))
 140
 141 ;;; variables
 142 (defmethod documentation ((x symbol) (doc-type (eql 'variable)))
 143   (values (info :variable :documentation x)))
 144
 145 (defmethod (setf documentation) (new-value
 146                                  (x symbol)
 147                                  (doc-type (eql 'variable)))
 148   (setf (info :variable :documentation x) new-value))
 149
 150 ;;; miscellaneous documentation. Compiler-macro documentation is stored
 151 ;;; as random-documentation and handled here.
 152 (defmethod documentation ((x symbol) (doc-type symbol))
 153   (cdr (assoc doc-type
 154               (values (info :random-documentation :stuff x)))))
 155
 156 (defmethod (setf documentation) (new-value (x symbol) (doc-type symbol))
 157   (let ((pair (assoc doc-type (info :random-documentation :stuff x))))
 158     (if pair
 159         (setf (cdr pair) new-value)
 160         (push (cons doc-type new-value)
 161               (info :random-documentation :stuff x))))
 162   new-value)
 163
 164 ;;; FIXME: The ((X SYMBOL) (DOC-TYPE SYMBOL)) method and its setf method should
 165 ;;; have parallel versions which accept LIST-valued X arguments (for function
 166 ;;; names in the (SETF FOO) style).
 167
 168 ;;; Now that we have created the machinery for setting documentation, we can
 169 ;;; set the documentation for the machinery for setting documentation.
 170 #+sb-doc
 171 (setf (documentation 'documentation 'function)
 172       "Return the documentation string of Doc-Type for X, or NIL if
 173   none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,
 174   SETF, and T.")