diff --git a/docs/docread/docread.scm b/docs/docread/docread.scm
index 56270df..33d7c68 100644
--- a/docs/docread/docread.scm
+++ b/docs/docread/docread.scm
@@ -42,13 +42,40 @@
                                   (cond
                                    ; If we see a preprocessed comment, collect it
                                    ((and (list? i) (eq? (car i) 'comment)) (set! comments (cons (cadr i) comments)))
-                                   
-                                   ; If we then see either a define or a define-record-type, emit the comments.
-                                   ((and (list? i) (or (eq? (car i) 'define) (eq? (car i) 'define-record-type)))
-                                    (if (list? (cadr i))
-                                        ; TODO(puck): bad code
-                                        (set! defines (cons (cons (car (cadr i)) (cons (cadr i) (reverse comments))) defines))
-                                        (set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines)))
+
+                                   ; (define-record-type <record-name> ...)
+                                   ((and (list? i) (eq? (car i) 'define-record-type))
+                                    (set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines))
+                                    (set! comments '()))
+
+                                   ; (define (foo bar baz) quux)
+                                   ((and (list? i) (eq? (car i) 'define) (list? (cadr i)))
+                                    (set! defines (cons (cons (car (cadr i)) (cons (cadr i) (reverse comments))) defines))
+                                    (set! comments '()))
+
+                                   ; (define foo (make-parameter ...))
+                                   ((and (list? i) (eq? (car i) 'define) (list? (list-ref i 2)) (eq? (car (list-ref i 2)) 'make-parameter))
+                                    (set! defines (cons (cons (cadr i) (cons (list (cadr i)) (reverse comments))) defines))
+                                    (set! comments '()))
+
+                                   ; (define foo (case-lambda ((bar baz) ...) ((quux aeou) ...) (rest ...)))
+                                   ((and (list? i) (eq? (car i) 'define) (list? (list-ref i 2)) (eq? (car (list-ref i 2)) 'case-lambda))
+                                    (let* ((extra-comments (map (lambda (vp) (if (list? vp) (sprintf "- `++~S++`" (cons (cadr i) (car vp))) (sprintf "- `++~S++`" (cons (cadr i) vp)))) (cdr (list-ref i 2))))
+                                           (entries (cdr (list-ref i 2)))
+                                           (first-entry-length (length (car entries)))
+                                           (last-entry (car (list-ref entries (- (length entries) 1))))
+                                           (repr (sprintf "\x28~S" (cadr i))))
+                                     (unless (list? last-entry) (set! last-entry (list (sprintf ". ~A" (symbol->string last-entry)))))
+                                     (do ((i 0 (+ i 1)) (n last-entry (cdr n)))
+                                         ((eq? n '()) #f)
+                                         (when (>= i (- first-entry-length 1)) (set-car! n (sprintf "[~A]" (symbol->string (car n))))))
+                                     (for-each (lambda (v) (set! repr (sprintf "~A ~A" repr v))) last-entry)
+                                     (set! defines (cons (cons (cadr i) (cons (string-append repr "\x29") (append extra-comments (list "") (reverse comments)))) defines))
+                                     (set! comments '())))
+
+                                   ; (define foo ...)
+                                   ((and (list? i) (eq? (car i) 'define))
+                                    (set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines))
                                     (set! comments '()))))
                               (cdr j)))))
               contents)
@@ -60,13 +87,13 @@
 
     (define out-file (open-output-file out-path))
     ; Print out the comments
-    (fprintf out-file "= `~S`\n\n" (car contents))
+    (fprintf out-file "= `~A`\n\n" (car contents))
     (for-each (lambda (l) (fprintf out-file "~A\n" l)) lib-comments)
     (fprintf out-file "\n:toc:\n\n")
     (for-each (lambda (i)
                   (define val (assoc i defines))
                   (unless (eq? val #f)
-                          (fprintf out-file "== `+~S+`\n" (cadr val))
+                          (fprintf out-file "== `+~A+`\n" (cadr val))
                           (for-each (lambda (l) (fprintf out-file "~A\n" l)) (cddr val))
                           (fprintf out-file "\n")))
               exports)