Factoring print-module-docs and print-module-binding-docs into (chibi doc).

Makefile

@@ -114,12 +114,12 @@ lib/chibi/ast$(SO): lib/chibi/ast.c $(INCLUDES)
 	-$(CC) $(CLIBFLAGS) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< $(GCLDFLAGS) -L. -lchibi-scheme
 
 doc/lib/chibi/%.html: lib/chibi/%.sld $(CHIBI_DOC_DEPENDENCIES)
-	$(CHIBI_DOC) chibi.$* > $@
+	$(CHIBI_DOC) --html chibi.$* > $@
 
 doc: doc/chibi.html doc-libs
 
 %.html: %.scrbl $(CHIBI_DOC_DEPENDENCIES)
-	$(CHIBI_DOC) $< > $@
+	$(CHIBI_DOC) --html $< > $@
 
 ########################################################################
 # Dist builds - rules to build generated files included in distribution

lib/chibi/doc.scm

@@ -573,19 +573,47 @@ div#footer {padding-bottom: 50px}
         (else #f)))
 
 ;; extract documentation from a module
-(define (extract-module-docs mod-name mod strict? . o)
+(define (extract-module-docs mod-name strict? . o)
-  (let* ((exports (if (pair? o) (car o) (module-exports mod)))
+  (let ((mod (load-module mod-name)))
-         (defs
+    (if (not mod)
-           (map (lambda (x)
+        (error "couldn't find module" mod-name)
-                  (let ((val (module-ref mod x)))
+        (let* ((exports (if (pair? o) (car o) (module-exports mod)))
-                    `(,x ,val ,(object-source val))))
+               (defs
-                exports)))
+                 (map (lambda (x)
-    (append
+                        (let ((val (module-ref mod x)))
-     (cond
+                          `(,x ,val ,(object-source val))))
-      ((find-module-file (module-name->file mod-name))
+                      exports)))
-       => (lambda (f) (reverse (extract-file-docs f defs strict? 'module))))
+          (append
-      (else '()))
+           (cond
-     (reverse (append-map (lambda (x) (extract-file-docs x defs strict?))
+            ((find-module-file (module-name->file mod-name))
-                          (module-includes mod)))
+             => (lambda (f) (reverse (extract-file-docs f defs strict? 'module))))
-     (reverse (append-map (lambda (x) (extract-file-docs x defs strict? 'ffi))
+            (else '()))
-                          (module-shared-includes mod))))))
+           (reverse (append-map (lambda (x) (extract-file-docs x defs strict?))
+                                (module-includes mod)))
+           (reverse (append-map (lambda (x) (extract-file-docs x defs strict? 'ffi))
+                                (module-shared-includes mod))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (print-module-docs mod-name . o)
+  (let ((out (if (pair? o) (car o) (current-output-port)))
+        (render (if (and (pair? o) (pair? (cdr o)))
+                    (cadr o)
+                    sxml-display-as-text)))
+    (render
+     (generate-docs
+      `((title ,(write-to-string mod-name))
+        ,@(apply extract-module-docs mod-name #f o))
+      (make-module-doc-env mod-name))
+     out)))
+
+(define (print-module-binding-docs mod-name var . o)
+  (let ((out (if (pair? o) (car o) (current-output-port)))
+        (render (if (and (pair? o) (pair? (cdr o)))
+                    (cadr o)
+                    sxml-display-as-text)))
+    (render
+     (generate-docs
+      (extract-module-docs mod-name #t (list var))
+      (make-module-doc-env mod-name))
+     out)))

lib/chibi/doc.sld

@@ -6,7 +6,8 @@
    (chibi time) (chibi filesystem) (chibi process)
    (chibi scribble) (chibi sxml) (chibi highlight)
    (chibi type-inference))
-  (export generate-docs expand-docs fixup-docs
+  (export print-module-docs print-module-binding-docs
+          generate-docs expand-docs fixup-docs
           extract-module-docs extract-file-docs
           make-default-doc-env make-module-doc-env)
   (include "doc.scm"))

tools/chibi-doc

@@ -1,7 +1,7 @@
 #! /usr/bin/env chibi-scheme
 
-(import (chibi)
+(import (scheme base)
-        (only (meta) load-module)
+        (scheme write)
         (scheme file)
         (scheme process-context)
         (chibi string)
@@ -11,9 +11,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (write-to-string x)
-  (call-with-output-string (lambda (out) (write x out))))
-
 ;; print an error and exit without a stack trace
 (define (die . args)
   (for-each display args)
@@ -25,20 +22,6 @@
   ((or render sxml-display-as-html)
    (generate-docs (scribble-parse in))))
 
-;; convert from a module to the output format
-(define (convert-module render mod-name mod . o)
-  ((or render sxml-display-as-html)
-   (generate-docs
-    `((title ,(write-to-string mod-name))
-      ,@(apply extract-module-docs mod-name mod #f o))
-    (make-module-doc-env mod-name))))
-
-(define (convert-module-var render mod-name mod var)
-  ((or render sxml-display-as-text)
-   (generate-docs
-    (extract-module-docs mod-name mod #t (list var))
-    (make-module-doc-env mod-name))))
-
 ;; utility to convert from "foo.bar" to (foo bar)
 (define (split-module-name str)
   (map (lambda (x) (or (string->number x) (string->symbol x)))
@@ -59,19 +42,14 @@
            (lambda (in) (convert-scribble render in))))
         (else
          ;; load the module so that examples work
-         (let* ((mod-name (split-module-name name))
+         (let ((mod-name (split-module-name name)))
-                (mod (load-module mod-name)))
+           (print-module-docs mod-name (current-output-port) render))))))
-           (if mod
-               (convert-module render mod-name mod)
-               (die "ERROR: couldn't find file or module: " name)))))))
     ((2)
      (let* ((name (car args))
             (var (cadr args))
-            (mod-name (split-module-name name))
+            (mod-name (split-module-name name)))
-            (mod (load-module mod-name)))
+       (print-module-binding-docs
-       (if mod
+        mod-name (string->symbol var) (current-output-port) render)))
-           (convert-module-var render mod-name mod (string->symbol var))
-           (die "ERROR: couldn't find module: " name))))
     (else
      (die "usage: chibi-doc [<scribble-file> | <module-name> [<var>]]"))))