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

93 lines
3.8 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
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
main-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
11 years ago
(require pollen/lang/inner-lang-helper)
(require-and-provide-project-require-files) ; only works if current-directory is set correctly
;; Change behavior of undefined identifiers with #%top
(require pollen/top)
(provide (all-from-out pollen/top))
11 years ago
;; Get project values
(require pollen/world)
(provide (all-from-out pollen/world))
;; Build 'inner-here-path and 'inner-here
11 years ago
(define (here-path->here here-path)
(path->string (path-replace-suffix (pollen-find-relative-path (CURRENT_PROJECT_ROOT) here-path) "")))
11 years ago
(define inner-here-path (get-here-path))
(define inner-here (here-path->here inner-here-path))
(provide (all-defined-out))
11 years ago
11 years ago
body-exprs ...)
11 years ago
(require 'inner)
11 years ago
;; Split out the metas.
(require txexpr)
11 years ago
(define (split-metas-to-hash tx)
;; return tx without metas, and meta hash
(define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
(define-values (main-without-metas meta-elements)
(splitf-txexpr tx is-meta-element?))
(define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value))))
11 years ago
(define metas (make-hash (map meta-element->assoc meta-elements)))
(values main-without-metas metas))
(define main-txexpr `(placeholder-root
,@(cons (meta 'here: inner-here)
(cons (meta 'here-path: inner-here-path)
;; cdr strips initial linebreak, but make sure main-raw isn't blank
(if (and (list? main-raw) (> 0 (length main-raw))) (cdr main-raw) main-raw)))))
11 years ago
(define-values (main-without-metas metas) (split-metas-to-hash main-txexpr))
;; set up the 'main export
(require pollen/decode)
;; set the parser mode based on reader mode
(define parser-mode
(if (reader-mode . equal? . 'auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (car (regexp-match file-ext-pattern inner-here-path))])
(cond
[(equal? here-ext (symbol->string PTREE_SOURCE_EXT)) 'ptree]
[(equal? here-ext (symbol->string DECODER_SOURCE_EXT)) 'markup]
[else 'pre]))
reader-mode))
11 years ago
(define main (apply (cond
[(equal? parser-mode 'ptree)
(λ xs (decode (cons PTREE_ROOT_NODE xs)
#:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))]
11 years ago
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(equal? parser-mode 'markup) root]
11 years ago
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag
(provide metas main
11 years ago
;; 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 (equal? parser-mode 'pre)
(display main)
(print main)))))