You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
pollen/main.rkt

78 lines
3.3 KiB
Racket

#lang racket/base
11 years ago
(provide (except-out (all-from-out racket/base) #%module-begin)
11 years ago
(rename-out [new-module-begin #%module-begin]))
11 years ago
(define-syntax-rule (new-module-begin body-exprs ...)
(#%module-begin
11 years ago
(module inner pollen/lang/doclang_raw
;; first three lines are positional arguments for doclang_raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
main-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
(require pollen/lang/lang-helper)
11 years ago
(require-and-provide-project-require-files)
;; Change behavior of undefined identifiers with #%top
(require pollen/top)
(provide (all-from-out pollen/top))
;; Build 'inner-here-path and 'inner-here
(define inner-here-path (get-here-path))
11 years ago
(require (only-in racket/path find-relative-path))
11 years ago
(require (only-in pollen/world PROJECT_ROOT))
(define inner-here (path->string (path-replace-suffix (find-relative-path PROJECT_ROOT inner-here-path) "")))
(provide (all-defined-out))
11 years ago
11 years ago
body-exprs ...)
11 years ago
(require 'inner)
;; Split out the metas.
(require txexpr)
(define main-txexpr `(placeholder-root ,@(cdr main-raw))) ;; cdr strips initial linebreak
(define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
(define-values (main-without-metas meta-elements)
(splitf-txexpr main-txexpr is-meta-element?))
(define meta-element->assoc (λ(x) (cons (cadr x) (caddr x))))
;; Prepend 'here-path and 'here as metas so they can be overridden by metas embedded in source.
(define metas (make-hash (map meta-element->assoc (cons `(meta "here-path" ,inner-here-path)
(cons `(meta "here" ,inner-here) meta-elements)))))
11 years ago
;; set up the 'main export
11 years ago
(require pollen/decode)
(require (only-in racket/list filter-not))
(define here-ext (car (regexp-match #px"\\w+$" inner-here-path)))
(define wants-decoder? (member here-ext (list "pd" "ptree")))
11 years ago
;(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.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[wants-decoder? root]
;; for preprocessor output, just make a string. Converts x-expressions to HTML.
[else (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag
;; derive 'here & 'here-path from the hash (because they might have been overridden in the source)
(define here (hash-ref metas "here"))
(define here-path (hash-ref metas "here-path"))
(provide metas main here here-path
;; hide the exports that were only for internal use.
(except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top))
;; for output in DrRacket
(module+ main
(if wants-decoder?
(print main)
(display main)))))