mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

modify parse behavior to discard newlines at the beginning of input file

Browse Source
pull/15/merge
Matthew Butterick 10 years ago
parent a000e3f00c
commit f3b065646b
1 changed files with 32 additions and 29 deletions
Show Stats Download Patch File Download Diff File

61
main-base.rkt
Unescape Escape View File

@ -9,7 +9,7 @@
(with-syntax ([new-module-begin (format-id stx "new-module-begin")]) (with-syntax ([new-module-begin (format-id stx "new-module-begin")])
#'(begin #'(begin
(provide (except-out (all-from-out racket/base) #%module-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) (define-syntax (new-module-begin stx-arg)
(syntax-case stx-arg () (syntax-case stx-arg ()
[(_ body-exprs (... ...)) [(_ body-exprs (... ...))
@ -44,16 +44,16 @@
;; todo: this won't work with inline submodules ;; todo: this won't work with inline submodules
(define parser-mode (define parser-mode
(if (not (procedure? reader-mode)) (if (not (procedure? reader-mode))
(if (equal? reader-mode world:mode-auto) (if (equal? reader-mode world:mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")] (let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))]) [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))])
(cond (cond
[(equal? here-ext world:pagetree-source-ext) world:mode-pagetree] [(equal? here-ext world:pagetree-source-ext) world:mode-pagetree]
[(equal? here-ext world:markup-source-ext) world:mode-markup] [(equal? here-ext world:markup-source-ext) world:mode-markup]
[(equal? here-ext world:markdown-source-ext) world:mode-markdown] [(equal? here-ext world:markdown-source-ext) world:mode-markdown]
[else world:mode-preproc])) [else world:mode-preproc]))
reader-mode) reader-mode)
mode-arg)) mode-arg))
;; Split out the metas. ;; Split out the metas.
@ -61,17 +61,17 @@
(define (meta-key x) (car (caadr x))) (define (meta-key x) (car (caadr x)))
(define (meta-value x) (cadr (caadr x))) (define (meta-value x) (cadr (caadr x)))
(define is-meta-element? (λ(x) (and (list? x) ; possible txexpr (define is-meta-element? (λ(x) (and (list? x) ; possible txexpr
(= (length x) 2) ; = tag + attribute (= (length x) 2) ; = tag + attribute
(equal? 'meta (car x)) ; tag is 'meta (equal? 'meta (car x)) ; tag is 'meta
(symbol? (meta-key x)) ; attribute key is symbol (symbol? (meta-key x)) ; attribute key is symbol
(string? (meta-value x))))) ; attribute value is string (string? (meta-value x))))) ; attribute value is string
(define (splitter x) (define (splitter x)
(define meta-acc null) (define meta-acc null)
(define (split-metas x) (define (split-metas x)
(cond (cond
[(list? x) (define-values (new-metas rest) (values (filter is-meta-element? x) (filter (compose1 not is-meta-element?) x))) [(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)) (set! meta-acc (append new-metas meta-acc))
(map split-metas rest)] (map split-metas rest)]
[else x])) [else x]))
(define result (split-metas x)) (define result (split-metas x))
(values result meta-acc)) (values result meta-acc))
@ -81,17 +81,20 @@
(define metas (make-hash (map meta-element->assoc meta-elements))) (define metas (make-hash (map meta-element->assoc meta-elements)))
(values doc-without-metas metas)) (values doc-without-metas metas))
(require racket/list)
(define doc-with-metas (define doc-with-metas
(let ([doc-raw (if (equal? parser-mode world:mode-markdown) (let ([doc-raw (if (equal? parser-mode world:mode-markdown)
(apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw) (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw)
doc-raw)]) doc-raw)])
`(placeholder-root `(placeholder-root
,@(cons (meta 'here-path: here-path) ,@(cons (meta 'here-path: here-path)
;; cdr strips initial linebreak, but make sure doc-raw isn't blank (if (list? doc-raw)
(if (and (list? doc-raw) (> (length doc-raw) 0) (equal? (car doc-raw) "\n")) (cdr doc-raw) doc-raw))))) (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
doc-raw)))))
(define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas))
;; set up the 'doc export ;; set up the 'doc export
(require pollen/decode) (require pollen/decode)
(define doc (apply (cond (define doc (apply (cond
@ -99,18 +102,18 @@
;; 'root is the hook for the decoder function. ;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(or (equal? parser-mode world:mode-markup) [(or (equal? parser-mode world:mode-markup)
(equal? parser-mode world:mode-markdown)) root] (equal? parser-mode world:mode-markdown)) root]
;; for preprocessor output, just make a string. ;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish [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 (provide metas doc
;; hide the exports that were only for internal use. ;; hide the exports that were only for internal use.
(except-out (all-from-out 'inner) doc-raw #%top)) (except-out (all-from-out 'inner) doc-raw #%top))
;; for output in DrRacket ;; for output in DrRacket
(module+ main (module+ main
(if (or (equal? parser-mode world:mode-preproc) (equal? parser-mode world:mode-template)) (if (or (equal? parser-mode world:mode-preproc) (equal? parser-mode world:mode-template))
(display doc) (display doc)
(print doc)))))]))))])) (print doc)))))]))))]))
Write Preview
Loading…
Cancel
Save