reader.rkt (3261B)
1 #lang s-exp syntax/module-reader 2 ;; Forked from scribble-lib/scribble/lp/lang/reader.rkt 3 4 hyper-literate/lang 5 6 #:read meta-read-inside 7 #:read-syntax meta-read-syntax-inside 8 #:whole-body-readers? #t 9 ;; don't use scribble-base-info for the #:info arg, since 10 ;; scribble/lp files are not directly scribble'able. 11 #:language-info (scribble-base-language-info) 12 #:info (wrapped-scribble-base-reader-info) 13 (require "meta-first-line.rkt" 14 (only-in scribble/base/reader 15 scribble-base-reader-info 16 scribble-base-language-info) 17 "first-line-utils.rkt") 18 19 (define orig-scribble-base-reader-info 20 (scribble-base-reader-info)) 21 22 (require syntax-color/scribble-lexer 23 syntax-color/racket-lexer 24 racket/port) 25 26 (define (wrapped-scribble-base-reader-info) 27 (define (read/at-exp in offset x-mode) 28 (define-values (mode2 lexr command-char mode) 29 (apply values x-mode)) 30 31 (define-values (r1 r2 r3 r4 r5 max-back-up new-mode) 32 (lexr in offset mode)) 33 (define new-x-mode (list 'main lexr command-char new-mode)) 34 35 (values r1 r2 r3 r4 r5 max-back-up new-x-mode)) 36 37 (define (make-lexr command-char) 38 (make-scribble-inside-lexer #:command-char (or command-char #\@))) 39 40 (define (read/options in offset x-mode) 41 (define-values (mode2 command-char depth) 42 (apply values x-mode)) 43 44 (define-values (txt type paren start end status) (racket-lexer/status in)) 45 (define new-depth (case status 46 [(open) (add1 depth)] 47 [(close) (sub1 depth)] 48 [else depth])) 49 ;; TODO: limit the number of newlines to a single newline. 50 (if (or 51 ;; Fallback to scribble mode fast if we get a close-paren too many. 52 ;; This could be because the text starts right after the last "config" 53 ;; expression (which would start on the first line, then continue). 54 (< new-depth 0) 55 (and (= new-depth 0) 56 (and (eq? type 'white-space) 57 (regexp-match #px"\n" txt)))) 58 (values txt type paren start end 59 0 (list 'main (make-lexr command-char) command-char #f)) 60 (let () 61 (define new-command-char 62 (or command-char 63 (if (memq type '(comment sexp-comment white-space)) 64 #f 65 (if (eq? type 'hash-colon-keyword) 66 (let ([rd (read (open-input-string txt))]) 67 (if (and (keyword? rd) 68 (= (string-length (keyword->string rd)) 1)) 69 (string-ref (keyword->string rd) 0) 70 #\@)) 71 #\@)))) 72 (values txt type paren start end 73 0 (list 'options new-command-char new-depth))))) 74 75 (lambda (key defval default) 76 (case key 77 [(color-lexer) 78 (λ (in offset x-mode) 79 (cond 80 [(eq? x-mode #f) 81 (read/options in offset (list 'options #f 0))] 82 [(eq? (car x-mode) 'options) 83 (read/options in offset x-mode)] 84 [else 85 (read/at-exp in offset x-mode)]))] 86 [else 87 (orig-scribble-base-reader-info key defval default)])))