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

chop

Browse Source
Matthew Butterick 9 years ago
parent c26838cd6c
commit cdc408340c
1 changed files with 83 additions and 75 deletions
Show Stats Download Patch File Download Diff File

158
pollen/private/reader-base.rkt
Unescape Escape View File

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require racket/syntax syntax/strip-context racket/class) (require racket/syntax syntax/strip-context racket/class (for-syntax racket/base racket/syntax))
(require (only-in scribble/reader make-at-reader) pollen/setup "project.rkt" racket/function) (require (only-in scribble/reader make-at-reader) "../setup.rkt" "project.rkt" racket/function)
(provide define+provide-reader-in-mode (all-from-out pollen/setup)) (provide define+provide-reader-in-mode (all-from-out "../setup.rkt"))
(define current-reader-mode (make-parameter #f)) (define current-reader-mode (make-parameter #f))
@ -11,77 +11,85 @@
(define (custom-read-syntax path-string p) (define (custom-read-syntax path-string p)
(define read-inner (make-at-reader (define read-inner (make-at-reader
#:command-char (setup:command-char) #:command-char (setup:command-char)
#:syntax? #t #:syntax? #t
#:inside? #t)) #:inside? #t))
(define source-stx (read-inner path-string p)) (define source-stx (read-inner path-string p))
(define reader-here-path (cond (define reader-here-path (cond
[(symbol? path-string) (symbol->string path-string)] [(symbol? path-string) (symbol->string path-string)]
[(equal? path-string "unsaved editor") path-string] [(equal? path-string "unsaved editor") path-string]
[else (path->string path-string)])) [else (path->string path-string)]))
(define parser-mode (if (eq? (current-reader-mode) default-mode-auto) (define parser-mode (if (eq? (current-reader-mode) default-mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")] (let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))] [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]
[auto-computed-mode (cond [auto-computed-mode (cond
[(eq? here-ext (setup:pagetree-source-ext)) default-mode-pagetree] [(eq? here-ext (setup:pagetree-source-ext)) default-mode-pagetree]
[(eq? here-ext (setup:markup-source-ext)) default-mode-markup] [(eq? here-ext (setup:markup-source-ext)) default-mode-markup]
[(eq? here-ext (setup:markdown-source-ext)) default-mode-markdown] [(eq? here-ext (setup:markdown-source-ext)) default-mode-markdown]
[else default-mode-preproc])]) [else default-mode-preproc])])
auto-computed-mode) auto-computed-mode)
default-mode-auto)) default-mode-auto))
(define post-parser-syntax (define post-parser-syntax
(with-syntax ([HERE-KEY (format-id #f "~a" (setup:here-path-key))] (with-syntax ([HERE-KEY (format-id #f "~a" (setup:here-path-key))]
[HERE-PATH (datum->syntax #f reader-here-path)] [HERE-PATH (datum->syntax #f reader-here-path)]
[POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources [POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources
[PARSER-MODE-VALUE (format-symbol "~a" parser-mode)] [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)]
[DIRECTORY-REQUIRES (datum->syntax #f (require+provide-directory-require-files path-string))] [DIRECTORY-REQUIRES (datum->syntax #f (require+provide-directory-require-files path-string))]
[(SOURCE-LINE ...) source-stx] [(SOURCE-LINE ...) source-stx]
[DOC (format-id #f "~a" (setup:main-export))]) [DOC (format-id #f "~a" (setup:main-export))])
(replace-context (replace-context
source-stx source-stx
#'(module runtime-wrapper racket/base #'(module runtime-wrapper racket/base
(module POLLEN-MOD pollen (module POLLEN-MOD pollen
(define-meta HERE-KEY HERE-PATH) (define-meta HERE-KEY HERE-PATH)
(define parser-mode 'PARSER-MODE-VALUE) (define parser-mode 'PARSER-MODE-VALUE)
(provide (except-out (all-defined-out) parser-mode) (provide (except-out (all-defined-out) parser-mode)
(prefix-out inner: parser-mode)) ; avoids conflicts with importing modules (prefix-out inner: parser-mode)) ; avoids conflicts with importing modules
DIRECTORY-REQUIRES DIRECTORY-REQUIRES
SOURCE-LINE ...) SOURCE-LINE ...)
(require (submod pollen/private/runtime-config show) 'POLLEN-MOD) (require (submod pollen/private/runtime-config show) 'POLLEN-MOD)
(provide (all-from-out 'POLLEN-MOD)) (provide (all-from-out 'POLLEN-MOD))
(show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config (show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config
(syntax-property post-parser-syntax (syntax-property post-parser-syntax
'module-language 'module-language
`#(pollen/private/language-info get-language-info ,reader-here-path))) ; reader-here-path acts as "top" runtime config `#(pollen/private/language-info get-language-info ,reader-here-path))) ; reader-here-path acts as "top" runtime config
(define (get-info in mod line col pos) (define (custom-get-info in mod line col pos)
;; DrRacket caches source file information per session, ;; DrRacket caches source file information per session,
;; so we can do the same to avoid multiple searches for the command char. ;; so we can do the same to avoid multiple searches for the command char.
(let ([command-char-cache (make-hash)]) (let ([command-char-cache (make-hash)])
(λ (key default) (λ (key default)
(case key (case key
[(color-lexer drracket:toolbar-buttons) ; only do source-path searching if we have one of these keys [(color-lexer drracket:toolbar-buttons) ; only do source-path searching if we have one of these keys
(define maybe-source-path (with-handlers ([exn:fail? (λ(exn) #f)]) (define maybe-source-path (with-handlers ([exn:fail? (λ(exn) #f)])
;; Robert Findler does not endorse `get-filename` here, ;; Robert Findler does not endorse `get-filename` here,
;; because it's sneaky and may not always work. ;; because it's sneaky and may not always work.
;; OTOH Scribble relies on it, so IMO it's highly unlikely to change. ;; OTOH Scribble relies on it, so IMO it's highly unlikely to change.
(let ([maybe-definitions-frame (object-name in)]) (let ([maybe-definitions-frame (object-name in)])
(send maybe-definitions-frame get-filename)))) ; will be #f if unsaved file (send maybe-definitions-frame get-filename)))) ; will be #f if unsaved file
(define my-command-char (hash-ref! command-char-cache maybe-source-path (λ _ (setup:command-char maybe-source-path)))) (define my-command-char (hash-ref! command-char-cache maybe-source-path (λ _ (setup:command-char maybe-source-path))))
(case key (case key
[(color-lexer) [(color-lexer)
(define my-make-scribble-inside-lexer (define my-make-scribble-inside-lexer
(dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #f))) (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #f)))
(cond [my-make-scribble-inside-lexer (cond [my-make-scribble-inside-lexer
(my-make-scribble-inside-lexer #:command-char my-command-char)] (my-make-scribble-inside-lexer #:command-char my-command-char)]
[else default])] [else default])]
[(drracket:toolbar-buttons) [(drracket:toolbar-buttons)
(define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons)) (define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons))
(my-make-drracket-buttons my-command-char)])] (my-make-drracket-buttons my-command-char)])]
[else default])))) [else default]))))
(define-syntax-rule (define+provide-reader-in-mode mode) (define-syntax (define+provide-reader-in-mode stx)
(begin (syntax-case stx ()
(current-reader-mode mode) [(_ mode)
(provide (rename-out [custom-read read] [custom-read-syntax read-syntax]) get-info))) (with-syntax ([cr (generate-temporary)]
[crs (generate-temporary)]
[cgi (generate-temporary)])
#'(begin
(current-reader-mode mode)
(define cgi custom-get-info)
(define cr custom-read)
(define crs custom-read-syntax)
(provide (rename-out [cr read][crs read-syntax][cgi get-info]))))]))
Write Preview
Loading…
Cancel
Save