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

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 91f2386..79c6c19 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -27,7 +27,7 @@
 ;;; Packaging.
 
 (defpackage #:zone
-  (:use #:common-lisp #:mdw.base #:mdw.str #:mdw.collect #:safely #:net)
+  (:use #:common-lisp #:mdw.base #:mdw.str #:collect #:safely #:net)
   (:export #:soa #:mx #:zone #:zone-record #:zone-subdomain
           #:*default-zone-source* #:*default-zone-refresh*
             #:*default-zone-retry* #:*default-zone-expire*
@@ -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)))