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

remove brain damage & cruft from #lang core; add runtime-config

Browse Source
pull/84/head
Matthew Butterick 9 years ago
parent 1da72be6d1
commit dfdc10c353
5 changed files with 129 additions and 109 deletions
Show Stats Download Patch File Download Diff File

7
language-info.rkt
Unescape Escape View File

@ -0,0 +1,7 @@
#lang racket/base
(provide get-language-info)
(define (get-language-info data)
(lambda (key default)
(case key
[(configure-runtime) '(#(pollen/runtime-config configure #f))]
[else default])))

117
main-base.rkt
Unescape Escape View File

@ -3,69 +3,64 @@
(provide (all-defined-out) (all-from-out pollen/world)) (provide (all-defined-out) (all-from-out pollen/world))
(define-syntax (define+provide-module-begin-in-mode stx) (define-syntax-rule (define+provide-module-begin-in-mode MODE-ARG)
(syntax-case stx () (begin
[(_ mode-arg) (provide (except-out (all-from-out racket/base) #%module-begin)
(with-syntax ([new-module-begin (format-id stx "new-module-begin")]) (rename-out [pollen-module-begin #%module-begin]))
#'(begin (define-syntax (pollen-module-begin stx)
(provide (except-out (all-from-out racket/base) #%module-begin) (syntax-case stx ()
(rename-out [new-module-begin #%module-begin])) [(_ EXPR (... ...))
(define-syntax (new-module-begin stx-arg) (with-syntax ([DOC (datum->syntax stx (world:current-main-export))]
(syntax-case stx-arg () [METAS (datum->syntax stx (world:current-meta-export))]
[(_ body-exprs (... ...)) [META (datum->syntax stx (world:current-meta-tag-name))]
(with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:current-meta-tag-name)))] [INNER (datum->syntax stx ''inner)])
[local-doc-export-name (format-id stx-arg (symbol->string (world:current-main-export)))] #'(#%module-begin
[local-metas-export-name (format-id stx-arg (symbol->string (world:current-meta-export)))]) (module inner pollen/doclang-raw
(syntax-protect ;; doclang_raw is a version of scribble/doclang with the decoder disabled
#'(#%module-begin ;; first three lines are positional arguments for doclang-raw
(module inner pollen/doclang-raw doc-raw ; id of export
;; doclang_raw is a version of scribble/doclang with the decoder disabled (λ(x) x) ; post-process function
;; first three lines are positional arguments for doclang-raw () ; prepended exprs
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
;; Change behavior of undefined identifiers with #%top ;; Change behavior of undefined identifiers with #%top
;; Get project values from world ;; Get project values from world
(require pollen/top pollen/world) (require pollen/top pollen/world)
(provide (all-defined-out) (all-from-out pollen/top pollen/world)) (provide (all-defined-out) (all-from-out pollen/top pollen/world))
EXPR (... ...))
body-exprs (... ...)) (require INNER 'inner pollen/metas) ; import inner twice: INNER for external use, 'inner for internal
(require 'inner racket/list pollen/metas) ;; in an inline module, reader-here-path and parser-mode are undefined
;; (because there's no reader)
;; but they'll become tag functions courtesy of #%top
;; so that's how we can detect if they are undefined
(define here-path (if (procedure? inner:reader-here-path)
"anonymous-module"
inner:reader-here-path))
(define parser-mode (if (procedure? inner:parser-mode)
MODE-ARG
inner:parser-mode))
;; in an inline module, reader-here-path and parser-mode are undefined ;; set up the DOC export
;; (because there's no reader) (define doc-elements (if (list? doc-raw) ; discard all newlines at front of file
;; but they'll become tag functions courtesy of #%top ((dynamic-require 'racket/list 'dropf) doc-raw (λ(i) (equal? i "\n")))
;; so that's how we can detect if they are undefined doc-raw)) ; single line
(define here-path (if (procedure? inner:reader-here-path) (define doc-with-metas (list* 'placeholder-root `(META (here-path ,here-path)) doc-elements))
"anonymous-module" (define-values (doc-without-metas METAS) (split-metas-to-hash doc-with-metas))
inner:reader-here-path)) (define DOC
(define parser-mode (if (procedure? inner:parser-mode) (let ([proc (cond
mode-arg [(equal? parser-mode world:mode-pagetree)
inner:parser-mode)) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
;; '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 world:mode-markup) root]
[(equal? parser-mode world:mode-markdown)
(λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append)
(map (dynamic-require 'pollen/decode 'to-string) xs))))]
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map (dynamic-require 'pollen/decode 'to-string) xs)))])]
[doc-elements-without-metas (cdr doc-without-metas)])
(apply proc doc-elements-without-metas)))
(define doc-with-metas ;; hide the exports that were only for internal use.
`(placeholder-root (provide DOC METAS (except-out (all-from-out INNER) doc-raw #%top))))]))))
,@(cons `(local-meta-tag-name (here-path ,here-path))
(if (list? 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)) ; split out the metas
;; set up the 'doc export
(require pollen/decode)
(define doc (apply (cond
[(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
;; '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 world:mode-markup) root]
[(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
;; hide the exports that were only for internal use.
(provide (rename-out [metas local-metas-export-name])
(rename-out [doc local-doc-export-name])
(except-out (all-from-out 'inner) doc-raw #%top)))))]))))]))

79
reader-base.rkt
Unescape Escape View File

@ -1,61 +1,56 @@
#lang racket/base #lang racket/base
(require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project) (require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project)
(provide define+provide-reader-in-mode (all-from-out pollen/world)) (provide define+provide-reader-in-mode (all-from-out pollen/world))
(define (make-custom-read custom-read-syntax-proc) (define (make-custom-read custom-read-syntax-proc)
(λ(p) (λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p))))
(syntax->datum
(custom-read-syntax-proc (object-name p) p))))
(require sugar/debug)
(define (make-custom-read-syntax reader-mode) (define (make-custom-read-syntax reader-mode)
(λ (path-string p) (λ (path-string p)
(define read-inner (make-at-reader (define read-inner (make-at-reader
#:command-char (if (or (equal? reader-mode world:mode-template) #:command-char (if (or (equal? reader-mode world:mode-template)
(and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string))) (and (string? path-string)
(regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string)))
(world:current-template-command-char) (world:current-template-command-char)
(world:current-command-char)) (world:current-command-char))
#:syntax? #t #:syntax? #t
#:inside? #t)) #:inside? #t))
(define file-contents (read-inner path-string p)) (define file-contents (read-inner path-string p))
(datum->syntax file-contents (syntax-property
`(module repl-wrapper racket/base (datum->syntax file-contents
(module pollen-lang-module pollen `(module runtime-wrapper racket/base
(define reader-mode ',reader-mode) (module pollen-lang-module pollen
(define reader-here-path ,(cond (define reader-mode ',reader-mode)
[(symbol? path-string) (symbol->string path-string)] (define reader-here-path ,(cond
[(equal? path-string "unsaved editor") path-string] [(symbol? path-string) (symbol->string path-string)]
[else (path->string path-string)])) [(equal? path-string "unsaved editor") path-string]
(define parser-mode [else (path->string path-string)]))
(if (equal? reader-mode world:mode-auto) (define parser-mode
(let* ([file-ext-pattern (pregexp "\\w+$")] (if (equal? reader-mode world:mode-auto)
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]) (let* ([file-ext-pattern (pregexp "\\w+$")]
(cond [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
[(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree] (cond
[(equal? here-ext (world:current-markup-source-ext)) world:mode-markup] [(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown] [(equal? here-ext (world:current-markup-source-ext)) world:mode-markup]
[else world:mode-preproc])) [(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown]
reader-mode)) [else world:mode-preproc]))
;; change names of exports for local use reader-mode))
;; so they don't conflict if this source is imported into another ;; change names of exports for local use
(provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode) ;; so they don't conflict if this source is imported into another
(prefix-out inner: reader-here-path) (provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode)
(prefix-out inner: reader-mode) (prefix-out inner: reader-here-path)
(prefix-out inner: parser-mode)) (prefix-out inner: reader-mode)
(prefix-out inner: parser-mode))
,(require+provide-directory-require-files path-string) ,(require+provide-directory-require-files path-string)
,@file-contents) ,@file-contents)
(require 'pollen-lang-module) (require (submod pollen/runtime-config show) 'pollen-lang-module)
(provide (all-from-out 'pollen-lang-module)) (provide (all-from-out 'pollen-lang-module))
(module+ main (show ,(world:current-main-export) inner:parser-mode))
(require txexpr racket/string) file-contents)
(if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template)) 'module-language
(display ,(world:current-main-export)) '#(pollen/language-info get-language-info #f))))
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))])
(validate-txexpr ,(world:current-main-export)))))))
file-contents)))
(define-syntax-rule (define+provide-reader-in-mode mode) (define-syntax-rule (define+provide-reader-in-mode mode)

22
runtime-config.rkt
Unescape Escape View File

@ -0,0 +1,22 @@
#lang racket/base
(provide configure)
(module show racket/base
(require pollen/world)
(provide show show-enabled)
(define show-enabled (make-parameter #f))
(define (show doc parser-mode)
(when (show-enabled)
(if (or (equal? parser-mode world:mode-preproc)
(equal? parser-mode world:mode-template))
(display doc)
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))])
((dynamic-require 'txexpr 'validate-txexpr) doc)))))))
(require 'show)
(define (configure data)
(show-enabled #t))

3
test/test-langs.rkt
Unescape Escape View File

@ -48,7 +48,8 @@
(with-output-to-string (λ() (system cmd-string)))) (with-output-to-string (λ() (system cmd-string))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)") (check-equal? (run test.ptree) "'(pagetree-root test ====)")
(check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")}) (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")})
(check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) ;; todo: this one's a little weird. Pollen-to-Pollen require prints the result of required file on import.
(check-equal? (run test-import.html.pm) @string-append{'(root "This is sample 01.")'(root "test" "\n" "====" "\n" (root "This is sample 01."))})
(check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))") (check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.no-ext) "test\n====")) (check-equal? (run test.no-ext) "test\n===="))

Write Preview
Loading…
Cancel
Save