Skip to content
Snippets Groups Projects
Commit e5e456d1 authored by ram's avatar ram
Browse files

Changed DOCUMENTATION to use INFO instead of plist hackery.

parent 144137c4
No related branches found
No related tags found
No related merge requests found
...@@ -19,31 +19,41 @@ ...@@ -19,31 +19,41 @@
short-site-name long-site-name dribble)) short-site-name long-site-name dribble))
(defun documentation (symbol doc-type) (defun documentation (name doc-type)
"Returns the documentation string of Doc-Type for the Symbol, or NIL if "Returns the documentation string of Doc-Type for Name, or NIL if
none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE, none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,
and SETF." and SETF."
(case doc-type (case doc-type
(variable (get symbol '%var-documentation)) (variable (info variable documentation name))
(function (get symbol '%fun-documentation)) (function (info function documentation name))
(structure (get symbol '%struct-documentation)) (structure
(type (get symbol '%type-documentation)) (when (eq (info type kind name) :structure)
(setf (get symbol '%setf-documentation)) (info type documentation name)))
(t (cdr (assoc doc-type (get symbol '%documentation)))))) (type
(info type documentation name))
(defun %set-documentation (symbol doc-type string) (setf (info setf documentation name))
(t
(cdr (assoc doc-type (info random-documentation stuff name))))))
(defun %set-documentation (name doc-type string)
(case doc-type (case doc-type
(variable (%put symbol '%var-documentation string)) (variable (setf (info variable documentation name) string))
(function (%put symbol '%fun-documentation string)) (function (setf (info function documentation name) string))
(structure (%put symbol '%struct-documentation string)) (structure
(type (%put symbol '%type-documentation string)) (unless (eq (info type kind name) :structure)
(setf (%put symbol '%setf-documentation string)) (error "~S is not the name of a structure type." name))
(t (let ((pair (assoc doc-type (get symbol '%documentation)))) (setf (info type documentation name) string))
(if pair (%rplacd pair string) (type (setf (info type documentation name) string))
(push (cons doc-type string) (get symbol '%documentation)))))) (setf (setf (info setf documentation name) string))
(t
(let ((pair (assoc doc-type (info random-documentation stuff name))))
(if pair
(setf (cdr pair) string)
(push (cons doc-type string)
(info random-documentation stuff name))))))
string) string)
(defvar *features* '(:common :cmu :mach :ibm-rt-pc :clos :new-compiler) (defvar *features* '(:common :cmu :mach :ibm-rt-pc :new-compiler)
"Holds a list of symbols that describe features provided by the "Holds a list of symbols that describe features provided by the
implementation.") implementation.")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment