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))
(define-syntax (define+provide-module-begin-in-mode stx)
(syntax-case stx ()
[(_ mode-arg)
(with-syntax ([new-module-begin (format-id stx "new-module-begin")])
#'(begin
(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [new-module-begin #%module-begin]))
(define-syntax (new-module-begin stx-arg)
(syntax-case stx-arg ()
[(_ body-exprs (... ...))
(with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:current-meta-tag-name)))]
[local-doc-export-name (format-id stx-arg (symbol->string (world:current-main-export)))]
[local-metas-export-name (format-id stx-arg (symbol->string (world:current-meta-export)))])
(syntax-protect
#'(#%module-begin
(module inner pollen/doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
(define-syntax-rule (define+provide-module-begin-in-mode MODE-ARG)
(begin
(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [pollen-module-begin #%module-begin]))
(define-syntax (pollen-module-begin stx)
(syntax-case stx ()
[(_ EXPR (... ...))
(with-syntax ([DOC (datum->syntax stx (world:current-main-export))]
[METAS (datum->syntax stx (world:current-meta-export))]
[META (datum->syntax stx (world:current-meta-tag-name))]
[INNER (datum->syntax stx ''inner)])
#'(#%module-begin
(module inner pollen/doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
;; Change behavior of undefined identifiers with #%top
;; Get project values from world
(require pollen/top pollen/world)
(provide (all-defined-out) (all-from-out pollen/top pollen/world))
;; Change behavior of undefined identifiers with #%top
;; Get project values from world
(require 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
;; (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))
;; set up the DOC export
(define doc-elements (if (list? doc-raw) ; discard all newlines at front of file
((dynamic-require 'racket/list 'dropf) doc-raw (λ(i) (equal? i "\n")))
doc-raw)) ; single line
(define doc-with-metas (list* 'placeholder-root `(META (here-path ,here-path)) doc-elements))
(define-values (doc-without-metas METAS) (split-metas-to-hash doc-with-metas))
(define DOC
(let ([proc (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 (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
`(placeholder-root
,@(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)))))]))))]))
;; hide the exports that were only for internal use.
(provide DOC METAS (except-out (all-from-out INNER) doc-raw #%top))))]))))

79
reader-base.rkt
Unescape Escape View File

@ -1,61 +1,56 @@
#lang racket/base
(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))
(define (make-custom-read custom-read-syntax-proc)
(λ(p)
(syntax->datum
(custom-read-syntax-proc (object-name p) p))))
(λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p))))
(require sugar/debug)
(define (make-custom-read-syntax reader-mode)
(λ (path-string p)
(define read-inner (make-at-reader
#: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-command-char))
#:syntax? #t
#:inside? #t))
(define file-contents (read-inner path-string p))
(datum->syntax file-contents
`(module repl-wrapper racket/base
(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
(define reader-here-path ,(cond
[(symbol? path-string) (symbol->string path-string)]
[(equal? path-string "unsaved editor") path-string]
[else (path->string path-string)]))
(define parser-mode
(if (equal? reader-mode world:mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
(cond
[(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:current-markup-source-ext)) world:mode-markup]
[(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc]))
reader-mode))
;; change names of exports for local use
;; so they don't conflict if this source is imported into another
(provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode)
(prefix-out inner: reader-here-path)
(prefix-out inner: reader-mode)
(prefix-out inner: parser-mode))
,(require+provide-directory-require-files path-string)
,@file-contents)
(require 'pollen-lang-module)
(provide (all-from-out 'pollen-lang-module))
(module+ main
(require txexpr racket/string)
(if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template))
(display ,(world:current-main-export))
(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)))
(syntax-property
(datum->syntax file-contents
`(module runtime-wrapper racket/base
(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
(define reader-here-path ,(cond
[(symbol? path-string) (symbol->string path-string)]
[(equal? path-string "unsaved editor") path-string]
[else (path->string path-string)]))
(define parser-mode
(if (equal? reader-mode world:mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
(cond
[(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:current-markup-source-ext)) world:mode-markup]
[(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc]))
reader-mode))
;; change names of exports for local use
;; so they don't conflict if this source is imported into another
(provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode)
(prefix-out inner: reader-here-path)
(prefix-out inner: reader-mode)
(prefix-out inner: parser-mode))
,(require+provide-directory-require-files path-string)
,@file-contents)
(require (submod pollen/runtime-config show) 'pollen-lang-module)
(provide (all-from-out 'pollen-lang-module))
(show ,(world:current-main-export) inner:parser-mode))
file-contents)
'module-language
'#(pollen/language-info get-language-info #f))))
(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))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)")
(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.pp) "test\n====")
(check-equal? (run test.no-ext) "test\n===="))

Write Preview
Loading…
Cancel
Save