From f7b6fafdf4097981e64590b3a260a14f0ae48bae Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Thu, 6 Feb 2003 15:47:35 +0000 Subject: [PATCH] * cmucl-documentation.lisp (documentation) <list, function>: Handle extended function names. (setf documentation): Likewise. --- pcl/cmucl-documentation.lisp | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/pcl/cmucl-documentation.lisp b/pcl/cmucl-documentation.lisp index aa190d689..511081f16 100644 --- a/pcl/cmucl-documentation.lisp +++ b/pcl/cmucl-documentation.lisp @@ -4,7 +4,7 @@ ;;; the public domain, and is provided 'as is'. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.9 2003/02/06 15:20:13 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.10 2003/02/06 15:47:35 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -24,10 +24,14 @@ (lisp::function-doc x)) (defmethod documentation ((x list) (doc-type (eql 'function))) - (when (eq (car x) 'setf) ; Give-up if not a setf function name. - (or (values (ext:info setf documentation (cadr x))) - ;; Try the pcl function documentation. - (and (fboundp x) (documentation (fdefinition x) 't))))) + (when (ext:valid-function-name-p x) + (if (eq (car x) 'setf) + (or (values (ext:info setf documentation (cadr x))) + (and (fboundp x) + (documentation (fdefinition x) t))) + (or (values (ext:info function documentation x)) + (and (fboundp x) + (documentation (fdefinition x) t)))))) (defmethod documentation ((x symbol) (doc-type (eql 'function))) (or (values (ext:info function documentation x)) @@ -38,7 +42,12 @@ (values (ext:info setf documentation x))) (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function))) - (setf (ext:info setf documentation (cadr x)) new-value)) + (unless (ext:valid-function-name-p x) + (error "Invalid function name ~s" x)) + (if (eq 'setf (cadr x)) + (setf (ext:info setf documentation (cadr x)) new-value) + (setf (ext:info function documentation x) new-value)) + new-value) (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function))) (setf (ext:info function documentation x) new-value)) -- GitLab