#lang racket/base (require racket/syntax syntax/strip-context racket/class racket/string racket/runtime-path setup/getinfo sugar/file (for-syntax racket/base) (only-in scribble/reader make-at-reader) "../setup.rkt" "project.rkt") (provide (rename-out [reader-module-begin #%module-begin]) (all-from-out "../setup.rkt")) (define (source-name->pollen-require-path source-name) ;; the `path-string` passed in from `read-syntax` can actually be `any/c` ;; captures paths, strings, "unsaved editor", path-strings, symbols ((if (syntax? source-name) syntax-source values) source-name)) (define (infer-parser-mode reader-mode reader-here-path) (cond [(eq? reader-mode default-mode-auto) (let ([val (cond [(get-ext reader-here-path) => string->symbol])]) (cond [(eq? val pollen-pagetree-source-ext) default-mode-pagetree] [(eq? val pollen-markup-source-ext) default-mode-markup] [(eq? val pollen-markdown-source-ext) default-mode-markdown] [else default-mode-preproc]))] [else reader-mode])) (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 source-stx (let ([read-inner (make-at-reader #:command-char (setup:command-char) #:syntax? #t #:inside? #t)]) (read-inner source-name input-port))) (define pollen-require-path (source-name->pollen-require-path source-name)) (define reader-here-path (format "~a" pollen-require-path)) (define parser-mode-from-reader (infer-parser-mode reader-mode reader-here-path)) (strip-context (with-syntax* ([POLLEN-MOD-NAME 'pollen-module] ;; the next two exist only in the reader because they are specific to file-based Pollen sources. ;; an inline Pollen submodule doesn't have "pollen.rkt" or `here-path` [POLLEN-REQUIRE-AND-PROVIDES (require+provide-directory-require-files pollen-require-path)] [HERE-PATH reader-here-path] [HERE-KEY pollen-here-path-key] [SOURCE-LINES source-stx] [DOC pollen-main-export] [META-MOD pollen-meta-export] [METAS-ID pollen-meta-export] [PARSER-MODE-FROM-READER parser-mode-from-reader]) #'(module runtime-wrapper racket/base (module configure-runtime racket/base (require pollen/private/runtime-config) (configure HERE-PATH)) ; HERE-PATH acts as "top" runtime config when module is main (module POLLEN-MOD-NAME pollen/private/main-base 'PARSER-MODE-FROM-READER (define-meta HERE-KEY HERE-PATH) POLLEN-REQUIRE-AND-PROVIDES . SOURCE-LINES) (module META-MOD racket/base (require (submod ".." POLLEN-MOD-NAME META-MOD)) (provide METAS-ID)) (require (only-in pollen/private/runtime-config show) 'POLLEN-MOD-NAME) (provide (all-from-out 'POLLEN-MOD-NAME)) (show DOC 'PARSER-MODE-FROM-READER HERE-PATH))))) ; HERE-PATH otherwise acts as "local" runtime config (define-runtime-path info-dir "..") (define ((custom-get-info mode) in mod line col pos) ;; DrRacket caches source file information per session, ;; so we can do the same to avoid multiple searches for the command char. (define command-char-cache (make-hash)) (λ (key default) (case key ;; only do source-path searching if we have one of these two keys [(color-lexer drracket:toolbar-buttons) (define maybe-source-path (with-handlers ([exn:fail? (λ (exn) #false)]) ;; Robert Findler does not endorse `get-filename` here, ;; because it's sneaky and may not always work. ;; OTOH Scribble relies on it, so IMO it's highly unlikely to change. (send (object-name in) get-filename))) (define my-command-char (hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path)))) (case key [(color-lexer) (define maybe-lexer (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false))) (cond [(procedure? maybe-lexer) (maybe-lexer #:command-char my-command-char)] [else default])] [(drracket:toolbar-buttons) (define maybe-button-maker (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false))) (when (procedure? maybe-button-maker) (maybe-button-maker my-command-char))])] [(drracket:indentation) (λ (text pos) (define line-idx (send text position-line pos)) (define line-start-pos (send text line-start-position line-idx)) (define line-end-pos (send text line-end-position line-idx)) (define first-vis-pos (or (for/first ([pos (in-range line-start-pos line-end-pos)] #:unless (char-blank? (send text get-character pos))) pos) line-start-pos)) (- first-vis-pos line-start-pos))] [(drracket:default-filters) ;; derive this from `module-suffixes` entry in main info.rkt file (define module-suffixes ((get-info/full info-dir) 'module-suffixes)) (define filter-strings (for/list ([suffix (in-list module-suffixes)]) (format "*.~a" suffix))) (list (list "Pollen sources" (string-join filter-strings ";")))] [(drracket:default-extension) (symbol->string (cond [(eq? mode default-mode-auto) pollen-preproc-source-ext] [(eq? mode default-mode-preproc) pollen-preproc-source-ext] [(eq? mode default-mode-markdown) pollen-markdown-source-ext] [(eq? mode default-mode-markup) pollen-markup-source-ext] [(eq? mode default-mode-pagetree) pollen-pagetree-source-ext]))] [else default]))) (define-syntax-rule (reader-module-begin mode . _) (#%module-begin (define cgi (custom-get-info mode)) ; stash hygienic references to local funcs with macro-introduced identifiers (define cr custom-read) ; so they can be provided out ;; allow six-argument arity to be compatible with `debug` (define (crs ps p . _) (custom-read-syntax #:reader-mode mode ps p)) (provide (rename-out [cr read][crs read-syntax][cgi get-info]))))