diff --git a/collects/scribble/doc/reader.ss b/collects/scribble/doc/reader.ss index 26113a90..2e9c3342 100644 --- a/collects/scribble/doc/reader.ss +++ b/collects/scribble/doc/reader.ss @@ -1,22 +1,23 @@ -#lang scheme/base +#lang s-exp syntax/module-reader + +scribble/doclang + +;; `read-inside' reads the whole body, so make wrapper1 return null so +;; we get the right syntax, and then make wrapper2 do the actual +;; reading. This might seem extreme, but I think that it's still +;; better to use module-reader for the subtleties it deals with. + +#:wrapper1 (lambda (t) '()) + +#:wrapper2 +(lambda (in read stx?) + (let* ([skeleton (read in)] + [skeleton (if stx? (syntax->list skeleton) skeleton)] + [body (if stx? + (scribble:read-syntax-inside (object-name in) in) + (scribble:read-inside in))] + [mod `(,(car skeleton) ,(cadr skeleton) ,(caddr skeleton) + (#%module-begin doc () . ,body))]) + (if stx? (datum->syntax #f mod) mod))) (require (prefix-in scribble: "../reader.ss")) - -(provide (rename-out [*read read]) - (rename-out [*read-syntax read-syntax])) - -(define (*read [inp (current-input-port)]) - (wrap inp (scribble:read-inside inp))) - -(define (*read-syntax [src #f] [port (current-input-port)]) - (wrap port (scribble:read-syntax-inside src port))) - -(define (wrap port body) - (let* ([p-name (object-name port)] - [name (if (path? p-name) - (let-values ([(base name dir?) (split-path p-name)]) - (string->symbol (path->string (path-replace-suffix name #"")))) - 'page)] - [id 'doc]) - `(module ,name scribble/doclang - (#%module-begin ,id () . ,body))))