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