diff --git a/info.rkt b/info.rkt index e697bc56..5197607e 100644 --- a/info.rkt +++ b/info.rkt @@ -12,7 +12,8 @@ "sexp-diff" "tr-immutable" "typed-map-lib" - "debug-scopes")) + "debug-scopes" + "syntax-color-lib")) (define build-deps '("scribble-lib" "racket-doc" "rackunit-doc" diff --git a/lang/first-line-utils.rkt b/lang/first-line-utils.rkt index e1ed3ca2..f0baf298 100644 --- a/lang/first-line-utils.rkt +++ b/lang/first-line-utils.rkt @@ -3,7 +3,9 @@ (require racket/port) (provide read-whole-first-line - read-syntax-whole-first-line) + read-syntax-whole-first-line + narrow-to-one-line + read-line-length) (define (read-line-length port) (let* ([peeking (peeking-input-port port)] diff --git a/lang/meta-first-line.rkt b/lang/meta-first-line.rkt index 21e20c62..28c93de0 100644 --- a/lang/meta-first-line.rkt +++ b/lang/meta-first-line.rkt @@ -10,7 +10,8 @@ "../comments/hide-comments.rkt") (provide meta-read-inside - meta-read-syntax-inside) + meta-read-syntax-inside + get-command-char) (define (make-at-reader+comments #:syntax? [syntax? #t] #:inside? [inside? #f] @@ -26,7 +27,7 @@ #:unsyntax #f)))) (define (get-command-char rd1) - (define rd1-datum (if (syntax? rd1) (syntax->datum rd1) rd1)) + (define rd1-datum (syntax->datum (datum->syntax #f rd1))) (if (and (pair? rd1-datum) (keyword? (car rd1-datum)) (= 1 (string-length (keyword->string (car rd1-datum))))) diff --git a/lang/reader.rkt b/lang/reader.rkt index 5ec3bd9e..b5d05038 100644 --- a/lang/reader.rkt +++ b/lang/reader.rkt @@ -9,7 +9,7 @@ hyper-literate/lang ;; don't use scribble-base-info for the #:info arg, since ;; scribble/lp files are not directly scribble'able. #:language-info (scribble-base-language-info) -#:info orig-scribble-base-reader-info ;(wrapped-scribble-base-reader-info) +#:info (wrapped-scribble-base-reader-info) (require "meta-first-line.rkt" (only-in scribble/base/reader scribble-base-reader-info @@ -18,20 +18,62 @@ hyper-literate/lang (define orig-scribble-base-reader-info (scribble-base-reader-info)) - + +(require syntax-color/scribble-lexer + syntax-color/racket-lexer + racket/port) + (define (wrapped-scribble-base-reader-info) + (define (read/at-exp in offset x-mode) + (define-values (mode2 lexr command-char mode) + (apply values x-mode)) + + (define-values (r1 r2 r3 r4 r5 max-back-up new-mode) + (lexr in offset mode)) + (define new-x-mode (list 'main lexr command-char new-mode)) + + (values r1 r2 r3 r4 r5 max-back-up new-x-mode)) + + (define (make-lexr command-char) + (make-scribble-inside-lexer #:command-char (or command-char #\@))) + + (define (read/options in offset x-mode) + (define-values (line column position) (port-next-location in)) + (define-values (mode2 command-char) + (apply values x-mode)) + + (define-values (txt type paren start end) (racket-lexer in)) + ;; TODO: limit the number of newlines to a single newline. + (if (and (eq? type 'white-space) + (regexp-match #px"\n" txt)) + (values txt type paren start end + 0 (list 'main (make-lexr command-char) command-char #f)) + (let () + (define new-command-char + (or command-char + (if (memq type '(comment sexp-comment white-space)) + #f + (if (eq? type 'hash-colon-keyword) + (let ([rd (read (open-input-string txt))]) + (if (and (keyword? rd) + (= (string-length (keyword->string rd)) 1)) + (string-ref (keyword->string rd) 0) + #\@)) + #\@)))) + (values txt type paren start end + 0 (list 'options new-command-char))))) + (lambda (key defval default) (case key [(color-lexer) - (let ([lexr (orig-scribble-base-reader-info key defval default)]) - (let ([first? #t]) - (λ (in offset mode) - (when first? - (set! first? #f) - ;; TODO: should return (values "#:opt" 'hash-colon-keyword …) for - ;; the options - (read-syntax-whole-first-line (object-name in) in)) - ;; Note that offset and mode are optional - (lexr in offset mode))))] + (λ (in offset x-mode) + (define-values (line column position) (port-next-location in)) + (cond + [(eq? x-mode #f) + (read/options in offset (list 'options #f))] + [(eq? (car x-mode) 'options) + (read/options in offset x-mode)] + [else + (read/at-exp in offset x-mode)]))] [else (orig-scribble-base-reader-info key defval default)])))