Supporting scribble extraction.

This commit is contained in:
Alex Shinn 2014-06-15 23:49:26 +09:00
parent 4b67a7bdb4
commit e8e3f701c5
3 changed files with 26 additions and 6 deletions

View file

@ -275,9 +275,21 @@
(dep-file (make-path dir (library-name->path dep)))) (dep-file (make-path dir (library-name->path dep))))
(and (file-exists? dep-file) dep-file)))) (and (file-exists? dep-file) dep-file))))
(define (package-doc cfg) (define (package-docs cfg spec libs)
;; TODO: Add scribble extraction. (cond
(conf-get cfg '(command package doc))) ((conf-get cfg '(command package doc)) => list)
((conf-get cfg '(command package doc-from-scribble))
(map
(lambda (lib)
(let* ((lib+files (extract-library cfg lib))
(lib-name (library-name (car lib+files))))
`(inline
,(string-append (library-name->path lib-name) ".html")
,(call-with-output-string
(lambda (out)
(print-module-docs lib-name out sxml-display-as-html))))))
libs))
(else '())))
(define (package-test cfg) (define (package-test cfg)
(conf-get cfg '(command package test))) (conf-get cfg '(command package test)))
@ -300,16 +312,22 @@
(define (package-spec+files cfg spec libs) (define (package-spec+files cfg spec libs)
(let ((recursive? (conf-get cfg '(command package recursive?))) (let ((recursive? (conf-get cfg '(command package recursive?)))
(doc (package-doc cfg)) (docs (package-docs cfg spec libs))
(test (package-test cfg)) (test (package-test cfg))
(version (package-output-version cfg))) (version (package-output-version cfg)))
(let lp ((ls (map (lambda (x) (cons x #f)) libs)) (let lp ((ls (map (lambda (x) (cons x #f)) libs))
(res (res
`(,@(if doc `((doc ,(path-strip-leading-parents doc))) '()) `(,@(if (pair? docs)
`((doc ,@(map
(lambda (x)
(path-strip-leading-parents
(if (pair? x) (cadr x) x)))
docs)))
'())
,@(if test `((test ,(path-strip-leading-parents test))) '()) ,@(if test `((test ,(path-strip-leading-parents test))) '())
,@(if version `((version ,version)) '()))) ,@(if version `((version ,version)) '())))
(files (files
`(,@(if doc (list doc) '()) `(,@docs
,@(if test (list test) '())))) ,@(if test (list test) '()))))
(cond (cond
((and (null? ls) (null? res)) ((and (null? ls) (null? res))

View file

@ -32,6 +32,7 @@
(chibi crypto md5) (chibi crypto md5)
(chibi crypto rsa) (chibi crypto rsa)
(chibi crypto sha2) (chibi crypto sha2)
(chibi doc)
(chibi filesystem) (chibi filesystem)
(chibi io) (chibi io)
(chibi match) (chibi match)

View file

@ -124,6 +124,7 @@
(version string) (version string)
(version-file existing-filename) (version-file existing-filename)
(doc existing-filename) (doc existing-filename)
(doc-from-scribble boolean)
(test existing-filename) (test existing-filename)
(sig-file existing-filename) (sig-file existing-filename)
)) ))