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

reader-base

Browse Source
dev-stylish
Matthew Butterick 6 years ago
parent 8ad4eb1180
commit 16a924c92f
2 changed files with 52 additions and 57 deletions
Show Stats Download Patch File Download Diff File

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

@ -4,7 +4,9 @@
racket/class racket/class
racket/string racket/string
racket/runtime-path racket/runtime-path
racket/match
setup/getinfo setup/getinfo
sugar/file
(for-syntax racket/base) (for-syntax racket/base)
(only-in scribble/reader make-at-reader) (only-in scribble/reader make-at-reader)
"../setup.rkt" "../setup.rkt"
@ -13,27 +15,20 @@
(define (source-name->pollen-require-path source-name) (define (source-name->pollen-require-path source-name)
;; the `path-string` passed in from `read-syntax` can actually be `any/c` ;; the `path-string` passed in from `read-syntax` can actually be `any/c`
(if (syntax? source-name) ;; captures paths, strings, "unsaved editor", path-strings, symbols
(syntax-source source-name) ((if (syntax? source-name) syntax-source values) source-name))
;; captures paths, strings, "unsaved editor", path-strings, symbols
source-name))
(define (infer-parser-mode reader-mode reader-here-path) (define (infer-parser-mode reader-mode reader-here-path)
(if (eq? reader-mode default-mode-auto) (match reader-mode
(let* ([file-ext-pattern (pregexp "\\w+$")] [(== default-mode-auto)
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))] (match (cond [(get-ext reader-here-path) => string->symbol])
[auto-computed-mode (cond [(== (setup:pagetree-source-ext)) default-mode-pagetree]
[(eq? here-ext (setup:pagetree-source-ext)) default-mode-pagetree] [(== (setup:markup-source-ext)) default-mode-markup]
[(eq? here-ext (setup:markup-source-ext)) default-mode-markup] [(== (setup:markdown-source-ext)) default-mode-markdown]
[(eq? here-ext (setup:markdown-source-ext)) default-mode-markdown] [_ default-mode-preproc])]
[else default-mode-preproc])]) [_ reader-mode]))
auto-computed-mode)
reader-mode))
(define (custom-read p)
(syntax->datum (custom-read-syntax (object-name p) p)))
(define (custom-read p) (syntax->datum (custom-read-syntax (object-name p) p)))
(define (custom-read-syntax #:reader-mode [reader-mode #f] source-name input-port) (define (custom-read-syntax #:reader-mode [reader-mode #f] source-name input-port)
(define source-stx (let ([read-inner (make-at-reader (define source-stx (let ([read-inner (make-at-reader
@ -78,44 +73,44 @@
(define ((custom-get-info mode) in mod line col pos) (define ((custom-get-info mode) 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)]) (define 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 ;; only do source-path searching if we have one of these two keys
(define maybe-source-path (with-handlers ([exn:fail? (λ (exn) #f)]) [(color-lexer drracket:toolbar-buttons)
;; Robert Findler does not endorse `get-filename` here, (define maybe-source-path
;; because it's sneaky and may not always work. (with-handlers ([exn:fail? (λ (exn) #false)])
;; OTOH Scribble relies on it, so IMO it's highly unlikely to change. ;; Robert Findler does not endorse `get-filename` here,
(let ([maybe-definitions-frame (object-name in)]) ;; because it's sneaky and may not always work.
(send maybe-definitions-frame get-filename)))) ; will be #f if unsaved file ;; OTOH Scribble relies on it, so IMO it's highly unlikely to change.
(define my-command-char (hash-ref! command-char-cache maybe-source-path (λ _ (setup:command-char maybe-source-path)))) (send (object-name in) get-filename)))
(case key (define my-command-char
[(color-lexer) (hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path))))
(define my-make-scribble-inside-lexer (case key
(dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #f))) [(color-lexer)
(if my-make-scribble-inside-lexer (match (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false))
(my-make-scribble-inside-lexer #:command-char my-command-char) [(? procedure? make-lexer) (make-lexer #:command-char my-command-char)]
default)] [_ default])]
[(drracket:toolbar-buttons) [(drracket:toolbar-buttons)
(define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons)) (match (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false))
(my-make-drracket-buttons my-command-char)])] [(? procedure? make-buttons) (make-buttons my-command-char)])])]
[(drracket:indentation) [(drracket:indentation)
(dynamic-require 'scribble/private/indentation 'determine-spaces)] (dynamic-require 'scribble/private/indentation 'determine-spaces)]
[(drracket:default-filters) [(drracket:default-filters)
;; derive this from `module-suffixes` entry in main info.rkt file ;; derive this from `module-suffixes` entry in main info.rkt file
(define module-suffixes ((get-info/full info-dir) 'module-suffixes)) (define module-suffixes ((get-info/full info-dir) 'module-suffixes))
(define filter-strings (for/list ([suffix (in-list module-suffixes)]) (define filter-strings (for/list ([suffix (in-list module-suffixes)])
(format "*.~a" suffix))) (format "*.~a" suffix)))
(list (list "Pollen sources" (string-join filter-strings ";")))] (list (list "Pollen sources" (string-join filter-strings ";")))]
[(drracket:default-extension) [(drracket:default-extension)
(symbol->string (symbol->string
(cond (match mode
[(eq? mode default-mode-auto) (setup:preproc-source-ext)] [(== default-mode-auto) (setup:preproc-source-ext)]
[(eq? mode default-mode-preproc) (setup:preproc-source-ext)] [(== default-mode-preproc) (setup:preproc-source-ext)]
[(eq? mode default-mode-markdown) (setup:markdown-source-ext)] [(== default-mode-markdown) (setup:markdown-source-ext)]
[(eq? mode default-mode-markup) (setup:markup-source-ext)] [(== default-mode-markup) (setup:markup-source-ext)]
[(eq? mode default-mode-pagetree) (setup:pagetree-source-ext)]))] [(== default-mode-pagetree) (setup:pagetree-source-ext)]))]
[else default])))) [else default])))
(define-syntax-rule (reader-module-begin mode . _) (define-syntax-rule (reader-module-begin mode . _)
(#%module-begin (#%module-begin

2
pollen/private/ts.rktd
Unescape Escape View File

@ -1 +1 @@
1540858384 1540858388

Write Preview
Loading…
Cancel
Save