|
|
|
@ -9,7 +9,7 @@
|
|
|
|
|
(with-syntax ([new-module-begin (format-id stx "new-module-begin")])
|
|
|
|
|
#'(begin
|
|
|
|
|
(provide (except-out (all-from-out racket/base) #%module-begin)
|
|
|
|
|
(rename-out [new-module-begin #%module-begin]))
|
|
|
|
|
(rename-out [new-module-begin #%module-begin]))
|
|
|
|
|
(define-syntax (new-module-begin stx-arg)
|
|
|
|
|
(syntax-case stx-arg ()
|
|
|
|
|
[(_ body-exprs (... ...))
|
|
|
|
@ -31,7 +31,7 @@
|
|
|
|
|
|
|
|
|
|
body-exprs (... ...))
|
|
|
|
|
|
|
|
|
|
(require 'inner)
|
|
|
|
|
(require 'inner racket/list)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; in an inline module, reader-here-path and parser-mode are undefined
|
|
|
|
@ -46,36 +46,44 @@
|
|
|
|
|
|
|
|
|
|
;; Split out the metas.
|
|
|
|
|
(define (split-metas-to-hash x)
|
|
|
|
|
(define (meta-key x) (car (caadr x)))
|
|
|
|
|
(define (meta-value x) (cadr (caadr x)))
|
|
|
|
|
(define is-meta-element? (λ(x) (and (list? x) ; possible txexpr
|
|
|
|
|
(>= (length x) 2) ; = tag + attribute + other elements (which are ignored)
|
|
|
|
|
(equal? 'meta (car x)) ; tag is 'meta
|
|
|
|
|
(symbol? (meta-key x)) ; attribute key is symbol
|
|
|
|
|
(string? (meta-value x))))) ; attribute value is string
|
|
|
|
|
(define (first-attribute x) (caadr x))
|
|
|
|
|
(define (meta-key x) (first (first-attribute x)))
|
|
|
|
|
(define (meta-value x) (second (first-attribute x)))
|
|
|
|
|
(define (properly-formed-meta-payload? x) (and (list? (second x))
|
|
|
|
|
(pair? (first-attribute x))
|
|
|
|
|
(symbol? (meta-key x)) ; attribute key is symbol
|
|
|
|
|
(string? (meta-value x)))) ; attribute value is string
|
|
|
|
|
(define is-meta-element?
|
|
|
|
|
(λ(x)
|
|
|
|
|
(define possible-meta (and (list? x) ; possible txexpr
|
|
|
|
|
(>= (length x) 2) ; = tag + attribute + other elements (which are ignored)
|
|
|
|
|
(equal? 'meta (car x)))) ; tag is 'meta
|
|
|
|
|
(if possible-meta
|
|
|
|
|
(if (properly-formed-meta-payload? x)
|
|
|
|
|
#t
|
|
|
|
|
(error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x))
|
|
|
|
|
#f)))
|
|
|
|
|
(define (splitter x)
|
|
|
|
|
(define meta-acc null)
|
|
|
|
|
(define meta-acc empty)
|
|
|
|
|
(define (split-metas x)
|
|
|
|
|
(cond
|
|
|
|
|
[(list? x) (define-values (new-metas rest) (values (filter is-meta-element? x) (filter (compose1 not is-meta-element?) x)))
|
|
|
|
|
(set! meta-acc (append new-metas meta-acc))
|
|
|
|
|
(map split-metas rest)]
|
|
|
|
|
[(list? x) (define-values (new-metas rest) (partition is-meta-element? x))
|
|
|
|
|
(set! meta-acc (append new-metas meta-acc))
|
|
|
|
|
(map split-metas rest)]
|
|
|
|
|
[else x]))
|
|
|
|
|
(define result (split-metas x))
|
|
|
|
|
(values result meta-acc))
|
|
|
|
|
|
|
|
|
|
(define-values (doc-without-metas meta-elements) (splitter x))
|
|
|
|
|
(define meta-xexpr (apply metaroot meta-elements))
|
|
|
|
|
(define meta-element->assoc (λ(x) (let ([key (meta-key x)][value (meta-value x)]) (cons key value))))
|
|
|
|
|
(define metas (make-hash (map meta-element->assoc (cdr meta-xexpr))))
|
|
|
|
|
(define metas-xexpr (apply metaroot meta-elements))
|
|
|
|
|
(define meta-element->assoc (λ(me) (cons (meta-key me) (meta-value me))))
|
|
|
|
|
(define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
|
|
|
|
|
(values doc-without-metas metas))
|
|
|
|
|
|
|
|
|
|
(require racket/list)
|
|
|
|
|
|
|
|
|
|
(define doc-with-metas
|
|
|
|
|
`(placeholder-root
|
|
|
|
|
,@(cons (meta 'here-path: here-path)
|
|
|
|
|
(if (list? doc-raw)
|
|
|
|
|
`(placeholder-root
|
|
|
|
|
,@(cons (meta 'here-path: here-path)
|
|
|
|
|
(if (list? doc-raw)
|
|
|
|
|
(dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
|
|
|
|
|
doc-raw))))
|
|
|
|
|
|
|
|
|
@ -91,9 +99,9 @@
|
|
|
|
|
[(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))]
|
|
|
|
|
;; for preprocessor output, just make a string.
|
|
|
|
|
[else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
|
|
|
|
|
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag
|
|
|
|
|
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide metas doc
|
|
|
|
|
;; hide the exports that were only for internal use.
|
|
|
|
|
(except-out (all-from-out 'inner) doc-raw #%top))))]))))]))
|
|
|
|
|
;; hide the exports that were only for internal use.
|
|
|
|
|
(except-out (all-from-out 'inner) doc-raw #%top))))]))))]))
|