Updated planet utility to accept full grammar for scribblings field in info.ss

svn: r12909
This commit is contained in:
Carl Eastlund 2008-12-19 21:14:36 +00:00
parent 3773b48ca9
commit 69556b1881

View File

@ -299,6 +299,44 @@
;; or the scribble renderer gets very confused ;; or the scribble renderer gets very confused
(define SCRIBBLE-DOCUMENT-DIR "planet-docs/") (define SCRIBBLE-DOCUMENT-DIR "planet-docs/")
;; scribble-entry? : Any -> Boolean
;; Recognizes valid list entries in info.ss's scribblings field.
(define scribble-entry?
(match-lambda
[(or (list (? string?))
(list (? string?) (? scribble-flags?))
(list (? string?) (? scribble-flags?) (? scribble-category?))
(list (? string?) (? scribble-flags?) (? scribble-category?) (? string?)))
#t]
[_ #f]))
;; scribble-flags? : Any -> Boolean
;; Recognizes a list of flags from an info.ss scribblings entry.
(define scribble-flags?
(match-lambda
[(list (? symbol?) ...) #t]
[_ #f]))
;; scribble-category : Any -> Boolean
;; Recognizes a category descriptor from an info.ss scribblings entry.
(define scribble-category?
(match-lambda
[(or (list (? symbol?))
(list (? symbol?) (? real?))) #t]
[_ #f]))
;; scribble-entry-file : ScribbleEntry -> String
;; Produces the filename of an info.ss scribblings entry.
(define scribble-entry-file
(match-lambda [(list file _ ...) file]))
;; scribble-entry-flags : ScribbleEntry -> (Listof Symbol)
;; Produces the list of flags from an info.ss scribblings entry.
(define scribble-entry-flags
(match-lambda
[(list _) null]
[(list _ flags _ ...) flags]))
;; make-planet-archive: path<directory> [path<file>] -> path<file> ;; make-planet-archive: path<directory> [path<file>] -> path<file>
;; Makes a .plt archive file suitable for PLaneT whose contents are ;; Makes a .plt archive file suitable for PLaneT whose contents are
;; all files in the given directory and returns that file's name. ;; all files in the given directory and returns that file's name.
@ -346,8 +384,10 @@
(error (format "malformed scribblings field; expected (listof (list string (listof symbol))), received ~e" (error (format "malformed scribblings field; expected (listof (list string (listof symbol))), received ~e"
scribble-files))) scribble-files)))
(for ([entry scribble-files]) (for ([entry scribble-files])
(match entry (unless (scribble-entry? entry)
[`(,(? string? filename) (,(? symbol? flags) ...)) (error "malformed scribblings entry"))
(let* ([filename (scribble-entry-file entry)]
[flags (scribble-entry-flags entry)])
(unless (and (relative-path? filename) (unless (and (relative-path? filename)
(subpath? abs-dir filename) (subpath? abs-dir filename)
(bytes=? (filename-extension filename) #"scrbl")) (bytes=? (filename-extension filename) #"scrbl"))
@ -359,8 +399,7 @@
[name (path-replace-suffix name.scrbl #"")]) [name (path-replace-suffix name.scrbl #"")])
(render (build-path filename) (render (build-path filename)
(build-path SCRIBBLE-DOCUMENT-DIR name) (build-path SCRIBBLE-DOCUMENT-DIR name)
(memq 'multi-page flags)))] (memq 'multi-page flags))))))))
[_ (error "malformed scribblings entry")])))))
(unless (unless
(or (null? critical-errors) (or (null? critical-errors)
@ -591,12 +630,7 @@
[scribblings [scribblings
(lambda (s) (lambda (s)
(and (list? s) (and (list? s)
(andmap (andmap scribble-entry? s)))
(lambda (item)
(match item
[`(,(? string?) (,(? symbol?) ...)) #t]
[_ #f]))
s)))
(void) (void)
(unless scribblings (unless scribblings
(warn "Package does not specify a scribblings field. Without a scribblings field, the package will not have browsable online documentation."))] (warn "Package does not specify a scribblings field. Without a scribblings field, the package will not have browsable online documentation."))]