suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
svn: r12909
This commit is contained in:
Carl Eastlund 2008-12-19 21:14:36 +00:00
parent 3773b48ca9
commit 69556b1881
1 changed files with 56 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/planet/util.ss
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.
@ -327,7 +365,7 @@
(λ (bad) (set! warnings (cons bad warnings))) (λ (bad) (set! warnings (cons bad warnings)))
(λ (err) (set! critical-errors (cons err critical-errors))))]) (λ (err) (set! critical-errors (cons err critical-errors))))])
(or real-info (λ (x [y (λ () (error 'info.ss (format "undefined field: ~a" x)))]) (y))))) (or real-info (λ (x [y (λ () (error 'info.ss (format "undefined field: ~a" x)))]) (y)))))
(let ([scribble-files (info.ss 'scribblings (λ () '()))]) (let ([scribble-files (info.ss 'scribblings (λ () '()))])
(define (outdir file-str) (define (outdir file-str)
@ -346,21 +384,22 @@
(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"))
(unless (and (relative-path? filename) (let* ([filename (scribble-entry-file entry)]
(subpath? abs-dir filename) [flags (scribble-entry-flags entry)])
(bytes=? (filename-extension filename) #"scrbl")) (unless (and (relative-path? filename)
(error "illegal scribblings file ~a (must be a file with extension .scrbl in the package directory or a subdirectory")) (subpath? abs-dir filename)
(unless (file-exists? (build-path abs-dir filename)) (bytes=? (filename-extension filename) #"scrbl"))
(error (format "scribblings file ~a not found" filename))) (error "illegal scribblings file ~a (must be a file with extension .scrbl in the package directory or a subdirectory"))
(printf "Building: ~a\n" filename) (unless (file-exists? (build-path abs-dir filename))
(let* ([name.scrbl (file-name-from-path filename)] (error (format "scribblings file ~a not found" filename)))
[name (path-replace-suffix name.scrbl #"")]) (printf "Building: ~a\n" filename)
(render (build-path filename) (let* ([name.scrbl (file-name-from-path filename)]
(build-path SCRIBBLE-DOCUMENT-DIR name) [name (path-replace-suffix name.scrbl #"")])
(memq 'multi-page flags)))] (render (build-path filename)
[_ (error "malformed scribblings entry")]))))) (build-path SCRIBBLE-DOCUMENT-DIR name)
(memq 'multi-page flags))))))))
(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."))]