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

preserve space with scribble/comment-reader

Browse Source 
svn: r14446
This commit is contained in:
Matthew Flatt 2009-04-07 18:57:15 +00:00
parent 1d26e97a35
commit de3d090f1a
2 changed files with 35 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/scribble/comment-reader.ss
View File

@ -12,7 +12,7 @@
(define (*read-syntax src [port (current-input-port)])
(parameterize ([current-readtable (make-comment-readtable)])
(read-syntax/recursive src port)))
(define (make-comment-readtable #:readtable [rt (current-readtable)])
(make-readtable rt
#\; 'terminating-macro
@ -35,13 +35,36 @@
`(code:comment
(unsyntax
(t
,@(let loop ()
(let ([c (read-char port)])
(cond
[(or (eof-object? c)
(char=? c #\newline))
null]
[(char=? c #\@)
(cons (recur) (loop))]
[else (cons (string c)
(loop))]))))))))
,@(append-strings
(let loop ()
(let ([c (read-char port)])
(cond
[(or (eof-object? c)
(char=? c #\newline))
null]
[(char=? c #\@)
(cons (recur) (loop))]
[else
(cons (string c)
(loop))]))))))))
(define (append-strings l)
(let loop ([l l][s null])
(cond
[(null? l) (if (null? s)
null
(list (apply string-append (reverse s))))]
[(and (equal? " " (car l))
(pair? s)
(equal? " " (car s)))
(append (loop null s)
(cons ''nbsp
(loop (cdr l) null)))]
[(string? (car l))
(loop (cdr l) (cons (car l) s))]
[else
(append (loop null s)
(cons
(car l)
(loop (cdr l) null)))]))))

2
collects/scribble/scheme.ss
View File

@ -338,7 +338,7 @@
(if (paragraph? v)
(map (lambda (v)
(let ([v (no-fancy-chars v)])
(if (string? v)
(if (or (string? v) (symbol? v))
(out v comment-color)
(out v #f))))
(paragraph-content v))