ptrees working

pull/9/head
Matthew Butterick 11 years ago
parent 49b17eff0d
commit c0969b50fc

@ -237,6 +237,16 @@
;; recursive whitespace test
(define/contract (whitespace? x)
(any/c . -> . boolean?)
(cond
[(or (string? x) (symbol? x)) (->boolean (regexp-match #px"^\\s+$" (->string x)))]
[(equal? "" x) #t] ; empty string is deemed whitespace
[(or (list? x) (vector? x)) (andmap whitespace? (->list x))]
[else #f]))
;; is x a paragraph break? ;; is x a paragraph break?
(define/contract (paragraph-break? x #:pattern [paragraph-pattern #px"^\n\n+$"]) (define/contract (paragraph-break? x #:pattern [paragraph-pattern #px"^\n\n+$"])
((any/c) (#:pattern pregexp?) . ->* . boolean?) ((any/c) (#:pattern pregexp?) . ->* . boolean?)

@ -42,15 +42,22 @@
(cons `(meta "here" ,inner-here) meta-elements))))) (cons `(meta "here" ,inner-here) meta-elements)))))
;; set up the 'main export ;; set up the 'main export
(require pollen/decode)
(require (only-in racket/list filter-not))
(define here-ext (car (regexp-match #px"\\w+$" inner-here-path))) (define here-ext (car (regexp-match #px"\\w+$" inner-here-path)))
(define wants-decoder? (member here-ext (list "pd" "ptree"))) (define wants-decoder? (member here-ext (list "pd" "ptree")))
(define main (apply (if wants-decoder? ;(print (cdr main-without-metas))
(define main (apply (cond
[(equal? here-ext "ptree") (λ xs (decode (cons 'ptree-root xs)
#:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]
;; '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 ...)
root [wants-decoder? root]
;; for preprocessor output, just make a string. Converts x-expressions to HTML. ;; for preprocessor output, just make a string. Converts x-expressions to HTML.
(λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))) [else (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag (cdr main-without-metas))) ;; cdr strips placeholder-root tag

@ -27,14 +27,6 @@
((txexpr? x) . and . ((car x) . in? . project-block-tags))) ((txexpr? x) . and . ((car x) . in? . project-block-tags)))
;; recursive whitespace test
(define+provide/contract (whitespace? x)
(any/c . -> . boolean?)
(cond
[(or (vector? x) (list? x) (set? x)) (andmap whitespace? (->list x))]
[(equal? "" x) #t] ; empty string is deemed whitespace
[(or (symbol? x) (string? x)) (->boolean (regexp-match #px"^\\s+$" (->string x)))]
[else #f]))

Loading…
Cancel
Save