[cldoc-cvs] CVS update: cldoc/src/cludg.lisp

[Iban Hatchondo]

Update of /project/cldoc/cvsroot/cldoc/src
In directory common-lisp.net:/tmp/cvs-serv18061

Modified Files:
	cludg.lisp 
Log Message:
Fix string documentation finding. Declaration forms can appear before the doc string in many lambda type. This case was not handled at all. The defstef-short-descriptor was not defining its lambda list.
Date: Sun Nov 20 23:33:25 2005
Author: ihatchondo

Index: cldoc/src/cludg.lisp
diff -u cldoc/src/cludg.lisp:1.1.1.1 cldoc/src/cludg.lisp:1.2
--- cldoc/src/cludg.lisp:1.1.1.1	Fri Nov 18 15:52:18 2005
+++ cldoc/src/cludg.lisp	Sun Nov 20 23:33:24 2005
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*-
-;;; $Id: cludg.lisp,v 1.1.1.1 2005/11/18 14:52:18 ihatchondo Exp $
+;;; $Id: cludg.lisp,v 1.2 2005/11/20 22:33:24 ihatchondo Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: Common Lisp Universal Documentation Generator
 ;;;   Created: 2005 10 23 12:30
@@ -100,9 +100,12 @@
 
 (defun extract-doc (forms)
   "Returns the first string found in the given list of forms.
-   NIL is returned if no string is found."
-  (loop for sub-form in forms until (stringp sub-form)
-	finally (return (and (stringp sub-form) sub-form))))
+   NIL is returned if no string is found before the first non
+   declare form."
+  (flet ((declare-p (form) (eq (car form) 'DECLARE)))
+    (loop for sub-form in forms
+	  until (or (stringp sub-form) (not (declare-p sub-form)))
+	  finally (return (and (stringp sub-form) sub-form)))))
 
 (defun grok-new-lines (string)
   "Returns a list of the string lines contained in the given string."
@@ -368,7 +371,8 @@
   (:documentation "This descriptor is made for: defsetf."))
 
 (defclass defsetf-short-descriptor (defsetf-descriptor)
-  ((update-fn :initarg :update-fn :initform nil :reader update-fn))
+  ((update-fn :initarg :update-fn :initform nil :reader update-fn)
+   (lambda-list :initform nil))
   (:documentation "This descriptor handles the short form of defsetf:
    (defsetf foo update-fn docstring)"))
 
@@ -518,7 +522,7 @@
     :type (format nil "~s" (first form))
     :name (format nil "~s" (second form))
     :lambda-list (third form)
-    :doc (when (stringp (fourth form)) (fourth form))))
+    :doc (extract-doc (cdddr form))))
 
 (define-descriptor-handler DEFMACRO (form)
   "macro"
@@ -526,7 +530,7 @@
     :type (format nil "~s" (first form))
     :name (format nil "~s" (second form))
     :lambda-list (third form)
-    :doc (when (stringp (fourth form)) (fourth form))))
+    :doc (extract-doc (cdddr form))))
 
 (define-descriptor-handler DEFSETF (form)
   "setf mapping"
@@ -540,7 +544,7 @@
 	:name (format nil "(setf ~s)" (second form))
 	:extra-args (third form)
 	:lambda-list (fourth form)
-	:doc (let ((d (fifth form))) (and (stringp d) d)))
+	:doc  (extract-doc (cddddr form)))
       (make-instance 'defsetf-short-descriptor
 	:type (format nil "~s" (first form))
 	:name (format nil "(setf ~s)" (second form))
@@ -809,7 +813,7 @@
       :name (format nil "~s" (second form))
       :qualifiers qualifiers
       :lambda-list lambda-list		       
-      :doc (extract-doc (cddr form)))))
+      :doc (extract-doc (if qualifiers (cddddr form) (cdddr form))))))
 
 (define-descriptor-handler DEFGENERIC (form)
   "generic function"