pull/218/head
Matthew Butterick 4 years ago
parent b242eb11dc
commit 9e3a0f59e8

@ -15,8 +15,16 @@
(rename-out [pollen-module-begin #%module-begin]) (rename-out [pollen-module-begin #%module-begin])
(all-from-out "../core.rkt" "../setup.rkt")) (all-from-out "../core.rkt" "../setup.rkt"))
(define ((make-parse-proc parser-mode root-proc) xs) (define (strip-leading-newlines doc)
(define (stringify xs) (apply string-append (map to-string xs))) ;; drop leading newlines, as they're often the result of `defines` and `requires`
(if (setup:trim-whitespace?)
(dropf doc (λ (ln) (member ln (list (setup:newline) ""))))
doc))
(define (stringify xs) (apply string-append (map to-string xs)))
(define (parse xs-in parser-mode root-proc)
(define xs (splice (strip-leading-newlines xs-in) (setup:splicing-tag)))
(match parser-mode (match parser-mode
[(== default-mode-pagetree eq?) (decode-pagetree xs)] [(== default-mode-pagetree eq?) (decode-pagetree xs)]
[(== default-mode-markup eq?) (apply root-proc (remove-voids xs))] [(== default-mode-markup eq?) (apply root-proc (remove-voids xs))]
@ -27,12 +35,6 @@
(apply root-proc xs))] (apply root-proc xs))]
[_ (stringify xs)])) ; preprocessor mode [_ (stringify xs)])) ; preprocessor mode
(define (strip-leading-newlines doc)
;; drop leading newlines, as they're often the result of `defines` and `requires`
(if (setup:trim-whitespace?)
(dropf doc (λ (ln) (member ln (list (setup:newline) ""))))
doc))
(define-syntax (pollen-module-begin stx) (define-syntax (pollen-module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ PARSER-MODE . EXPRS) [(_ PARSER-MODE . EXPRS)
@ -45,15 +47,12 @@
[ALL-DEFINED-OUT (datum->syntax #'EXPRS '(all-defined-out))]) [ALL-DEFINED-OUT (datum->syntax #'EXPRS '(all-defined-out))])
#'(doclang:#%module-begin #'(doclang:#%module-begin
DOC-ID ; positional arg for doclang-raw: name of export DOC-ID ; positional arg for doclang-raw: name of export
(λ (xs) ; positional arg for doclang-raw: post-processor (λ (xs) ; positional arg for doclang-raw: post-processor
(define proc (make-parse-proc PARSER-MODE ROOT-ID)) ;; wait till the end to restore prev-metas
(define trimmed-xs (strip-leading-newlines xs)) ;; because tag functions may edit current-metas
(define doc-elements (splice trimmed-xs (setup:splicing-tag))) ;; and we want root to see those changes
(begin0 (begin0
(proc doc-elements) (parse xs PARSER-MODE ROOT-ID)
;; wait till the end to restore prev-metas
;; because tag functions may edit current-metas
;; and we want root to see those changes
(current-metas prev-metas))) (current-metas prev-metas)))
(module METAS-ID racket/base (module METAS-ID racket/base
(provide METAS-ID) (provide METAS-ID)

@ -1 +1 @@
1578804970 1578891880

Loading…
Cancel
Save