suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

* Parameterized comment-reader over 'unsyntax, for use with RACKETBLOCK

Browse Source 
pkgs/scribble-pkgs/scribble-lib/scribble/comment-reader.rkt

original commit: 57dd977cb7acc0d1442c46a2e6059b48a13e95eb
This commit is contained in:
William J. Bowman 2013-11-24 18:20:32 -05:00 committed by Matthew Flatt
parent e4d4904298
commit 06fcc23c24
1 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/scribble-pkgs/scribble-lib/scribble/comment-reader.rkt
View File

@ -1,18 +1,29 @@
(module comment-reader scheme/base (module comment-reader scheme/base
(provide (rename-out [*read read] (provide (rename-out [*read read]
[*read-syntax read-syntax]) [*read-syntax read-syntax])
make-comment-readtable) make-comment-readtable)
(define unsyntaxer (make-parameter 'unsyntax))
(define (*read [inp (current-input-port)]) (define (*read [inp (current-input-port)])
(parameterize ([current-readtable (make-comment-readtable)]) (parameterize ([unsyntaxer (read-unsyntaxer inp)]
[current-readtable (make-comment-readtable)])
(read/recursive inp))) (read/recursive inp)))
(define (*read-syntax src [port (current-input-port)]) (define (*read-syntax src [port (current-input-port)])
(parameterize ([current-readtable (make-comment-readtable)]) (parameterize ([unsyntaxer (read-unsyntaxer port)]
[current-readtable (make-comment-readtable)])
(read-syntax/recursive src port))) (read-syntax/recursive src port)))
(define (read-unsyntaxer port)
(let-values ([(l c p) (port-next-location port)])
(if (eq? (read port) '#:unsyntax)
(read port)
(begin
(set-port-next-location! port l c p)
'unsyntax))))
(define (make-comment-readtable #:readtable [rt (current-readtable)]) (define (make-comment-readtable #:readtable [rt (current-readtable)])
(make-readtable rt (make-readtable rt
#\; 'terminating-macro #\; 'terminating-macro
@ -35,7 +46,7 @@
(when (equal? #\space (peek-char port)) (when (equal? #\space (peek-char port))
(read-char port)) (read-char port))
`(code:comment `(code:comment
(unsyntax (,(unsyntaxer)
(t (t
,@(append-strings ,@(append-strings
(let loop () (let loop ()
@ -71,5 +82,3 @@
(list `(hspace ,(- (cdar m) (caar m)))) (list `(hspace ,(- (cdar m) (caar m))))
(preserve-space (substring s (cdar m)))) (preserve-space (substring s (cdar m))))
(list s))))) (list s)))))