Skip to content
Snippets Groups Projects
Commit 5298c4eb authored by dtc's avatar dtc
Browse files

Strip out the call to pcl::documentation from lisp:documentation; the

pcl version can simply replace the lisp version now.
parent 0153df20
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.24 1997/08/16 09:32:44 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.25 1997/09/03 19:36:26 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -61,10 +61,7 @@ ...@@ -61,10 +61,7 @@
"Returns the documentation string of Doc-Type for X, or NIL if "Returns the documentation string of Doc-Type for X, or NIL if
none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE, none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,
SETF, and T." SETF, and T."
(flet ((try-generic-doc (x doc-type) (flet (;; CMUCL random-documentation.
(and (fboundp 'pcl::documentation)
(pcl::documentation x doc-type)))
;; CMUCL random-documentation.
(try-cmucl-random-doc (x doc-type) (try-cmucl-random-doc (x doc-type)
(declare (symbol doc-type)) (declare (symbol doc-type))
(cdr (assoc doc-type (cdr (assoc doc-type
...@@ -72,39 +69,31 @@ ...@@ -72,39 +69,31 @@
(case doc-type (case doc-type
(variable (variable
(typecase x (typecase x
(symbol (values (info variable documentation x))) (symbol (values (info variable documentation x)))))
(t (try-generic-doc x doc-type))))
(function (function
(typecase x (typecase x
(symbol (values (info function documentation x))) (symbol (values (info function documentation x)))
(function (function-doc x)) (function (function-doc x))
(list ;; Must be '(setf symbol) (list ;; Must be '(setf symbol)
(values (info function documentation (cadr x)))) (values (info function documentation (cadr x))))))
(t (try-generic-doc x doc-type))))
(structure (structure
(typecase x (typecase x
(symbol (when (eq (info type kind x) :instance) (symbol (when (eq (info type kind x) :instance)
(values (info type documentation x)))) (values (info type documentation x))))))
(t (try-generic-doc x doc-type))))
(type (type
(typecase x (typecase x
(structure-class (values (info type documentation (class-name x)))) (structure-class (values (info type documentation (class-name x))))
(t (or (and (typep x 'symbol) (values (info type documentation x))) (t (and (typep x 'symbol) (values (info type documentation x))))))
(try-generic-doc x doc-type)))))
(setf (info setf documentation x)) (setf (info setf documentation x))
((t) ((t)
(typecase x (typecase x
(function (function-doc x)) (function (function-doc x))
(package (package-doc-string x)) (package (package-doc-string x))
(structure-class (values (info type documentation (class-name x)))) (structure-class (values (info type documentation (class-name x))))
(symbol (or (try-generic-doc x doc-type) (symbol (try-cmucl-random-doc x doc-type))))
(try-cmucl-random-doc x doc-type)))
(t (try-generic-doc x doc-type))))
(t (t
(typecase x (typecase x
(symbol (or (try-generic-doc x doc-type) (symbol (try-cmucl-random-doc x doc-type)))))))
(try-cmucl-random-doc x doc-type)))
(t (try-generic-doc x doc-type)))))))
(defun %set-documentation (name doc-type string) (defun %set-documentation (name doc-type string)
(case doc-type (case doc-type
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment