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

fix `codeblock' interaction with reader macros

Browse Source 
Closes PR 11386

original commit: 090f82cc0b22077664ddf1174cc219694a55e0c7
This commit is contained in:
Matthew Flatt 2011-01-16 18:35:03 -07:00
parent 5de2c07566
commit b4e0d832da
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/scribble/private/manual-code.rkt
View File

@ -68,7 +68,11 @@
[(and (identifier? e) [(and (identifier? e)
(syntax-original? e)) (syntax-original? e))
(let ([pos (sub1 (syntax-position e))]) (let ([pos (sub1 (syntax-position e))])
(list (list (to-element e) (list (list (lambda (str)
(to-element (syntax-property
e
'display-string
str)))
pos pos
(+ pos (syntax-span e)) (+ pos (syntax-span e))
1)))] 1)))]
@ -142,8 +146,11 @@
[(null? tokens) (split-lines default-color (substring* bstr pos))] [(null? tokens) (split-lines default-color (substring* bstr pos))]
[(eq? (caar tokens) 'white-space) (loop pos (cdr tokens))] [(eq? (caar tokens) 'white-space) (loop pos (cdr tokens))]
[(= pos (cadar tokens)) [(= pos (cadar tokens))
(append (let ([style (caar tokens)]) (append (let ([style (caar tokens)]
(if (symbol? style) [get-str (lambda ()
(substring* bstr (cadar tokens) (caddar tokens)))])
(cond
[(symbol? style)
(let ([scribble-style (let ([scribble-style
(case style (case style
[(symbol) symbol-color] [(symbol) symbol-color]
@ -151,9 +158,10 @@
[(constant string) value-color] [(constant string) value-color]
[(comment) comment-color] [(comment) comment-color]
[else default-color])]) [else default-color])])
(split-lines scribble-style (split-lines scribble-style (get-str)))]
(substring* bstr (cadar tokens) (caddar tokens)))) [(procedure? style)
(list (caar tokens)))) (list (style (get-str)))]
[else (list style)]))
(loop (caddar tokens) (cdr tokens)))] (loop (caddar tokens) (cdr tokens)))]
[(> pos (cadar tokens)) [(> pos (cadar tokens))
(loop pos (cdr tokens))] (loop pos (cdr tokens))]