defzoneparse: Parse the body; handle docstring and declarations properly.

diff --git a/zone.lisp b/zone.lisp
index 1f421a5..79c6c19 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -502,25 +502,28 @@ accept the arguments)."
   (setf types (listify types))
   (let* ((type (car types))
         (func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
-    (with-gensyms (col tname ttype tttl tdata tdefsubp i)
-      `(progn
-        (dolist (,i ',types)
-          (setf (get ,i 'zone-parse) ',func))
-        (defun ,func (,name ,data ,ttl ,col ,zname ,defsubp)
-          (declare (ignorable ,zname ,defsubp))
-          (flet ((,list (&key ((:name ,tname) ,name)
-                              ((:type ,ttype) ,type)
-                              ((:data ,tdata) ,data)
-                              ((:ttl ,tttl) ,ttl)
-                              ((:defsubp ,tdefsubp) nil))
-                   (collect (make-zone-record :name ,tname
-                                              :type ,ttype
-                                              :data ,tdata
-                                              :ttl ,tttl
-                                              :defsubp ,tdefsubp)
-                            ,col)))
-            ,@body))
-        ',type))))
+    (multiple-value-bind (doc decls body) (parse-body body)
+      (with-gensyms (col tname ttype tttl tdata tdefsubp i)
+       `(progn
+          (dolist (,i ',types)
+            (setf (get ,i 'zone-parse) ',func))
+          (defun ,func (,name ,data ,ttl ,col ,zname ,defsubp)
+            ,@doc
+            ,@decls
+            (declare (ignorable ,zname ,defsubp))
+            (flet ((,list (&key ((:name ,tname) ,name)
+                                ((:type ,ttype) ,type)
+                                ((:data ,tdata) ,data)
+                                ((:ttl ,tttl) ,ttl)
+                                ((:defsubp ,tdefsubp) nil))
+                     (collect (make-zone-record :name ,tname
+                                                :type ,ttype
+                                                :data ,tdata
+                                                :ttl ,tttl
+                                                :defsubp ,tdefsubp)
+                              ,col)))
+              ,@body))
+          ',type)))))
 
 (defun zone-parse-records (zone records)
   (let ((zname (zone-name zone)))