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

switch `codeblock' to strings instead of bytes

Browse Source 
Also, fix scribble lexer line counting.

Closes PR 12225
This commit is contained in:
Matthew Flatt 2011-11-27 10:08:07 -07:00
parent 8b7370a4f9
commit fca5ceecc9
4 changed files with 35 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -55,9 +55,10 @@
#:line-numbers [line-numbers #f] #:line-numbers [line-numbers #f]
#:block? [block? #t] #:block? [block? #t]
. strs) . strs)
(let* ([str (apply string-append strs)] (let* ([xstr (apply string-append strs)]
[bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))] [bstr (regexp-replace* #rx"(?m:^$)" xstr "\xA0")]
[in (open-input-bytes bstr)]) [in (open-input-string bstr)])
(port-count-lines! in)
(let* ([tokens (let* ([tokens
(let loop ([mode #f]) (let loop ([mode #f])
(let-values ([(lexeme type data start end backup-delta mode) (let-values ([(lexeme type data start end backup-delta mode)
@ -66,15 +67,14 @@
null null
(cons (list type (sub1 start) (sub1 end) 0) (cons (list type (sub1 start) (sub1 end) 0)
(loop mode)))))] (loop mode)))))]
[substring* (lambda (bstr start [end (bytes-length bstr)])
(bytes->string/utf-8 (subbytes bstr start end)))]
[e (parameterize ([read-accept-reader #t]) [e (parameterize ([read-accept-reader #t])
((or expand ((or expand
(lambda (stx) (lambda (stx)
(if context (if context
(replace-context context stx) (replace-context context stx)
stx))) stx)))
(let ([p (open-input-bytes bstr)]) (let ([p (open-input-string bstr)])
(port-count-lines! p)
(let loop () (let loop ()
(let ([v (read-syntax 'prog p)]) (let ([v (read-syntax 'prog p)])
(cond (cond
@ -138,8 +138,8 @@
(link-mod (link-mod
#:orig? #t #:orig? #t
(datum->syntax #f (datum->syntax #f
(string->symbol (bytes->string/utf-8 (cadr m))) (string->symbol (cadr m))
(vector 'in 1 6 7 (bytes-length (cadr m)))) (vector 'in 1 6 7 (string-length (cadr m))))
3) 3)
null)) null))
null)] null)]
@ -166,12 +166,12 @@
(let loop ([pos 0] (let loop ([pos 0]
[tokens tokens]) [tokens tokens])
(cond (cond
[(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)]
[get-str (lambda () [get-str (lambda ()
(substring* bstr (cadar tokens) (caddar tokens)))]) (substring bstr (cadar tokens) (caddar tokens)))])
(cond (cond
[(symbol? style) [(symbol? style)
(let ([scribble-style (let ([scribble-style
@ -189,7 +189,7 @@
[(> pos (cadar tokens)) [(> pos (cadar tokens))
(loop pos (cdr tokens))] (loop pos (cdr tokens))]
[else (append [else (append
(split-lines default-color (substring* bstr pos (cadar tokens))) (split-lines default-color (substring bstr pos (cadar tokens)))
(loop (cadar tokens) tokens))])))))))) (loop (cadar tokens) tokens))]))))))))
(define (typeset-code-line context expand lang-line . strs) (define (typeset-code-line context expand lang-line . strs)

7
collects/syntax-color/scribble-lexer.rkt
View File

@ -23,7 +23,7 @@
(hash-set! rx-keys rx (make-ephemeron rx bstr)) (hash-set! rx-keys rx (make-ephemeron rx bstr))
rx)))) rx))))
(define (scribble-inside-lexer in offset mode) (define (scribble-inside-lexer orig-in offset mode)
(let ([mode (or mode (let ([mode (or mode
(list (list
(make-text #rx"^@" (make-text #rx"^@"
@ -32,10 +32,13 @@
#rx".*?(?:(?=[@\r\n])|$)" #rx".*?(?:(?=[@\r\n])|$)"
#f #f
#f)))] #f)))]
[in (special-filter-input-port in [in (special-filter-input-port orig-in
(lambda (v s) (lambda (v s)
(bytes-set! s 0 (char->integer #\.)) (bytes-set! s 0 (char->integer #\.))
1))]) 1))])
(let-values ([(line col pos) (port-next-location orig-in)])
(when line
(port-count-lines! in)))
(let-values ([(line col pos) (port-next-location in)] (let-values ([(line col pos) (port-next-location in)]
[(l) (car mode)]) [(l) (car mode)])

12
collects/tests/scribble/docs/codeblock-utf8.scrbl Normal file
View File

@ -0,0 +1,12 @@
#lang scribble/base
@(require scribble/manual)
@defmodulereader[scribble/manual]
@codeblock|{
#lang scribble/manual
(λ x x)
@interaction[1
42]
}|

7
collects/tests/scribble/docs/codeblock-utf8.txt Normal file
View File

@ -0,0 +1,7 @@
 #reader scribble/manual
#lang scribble/manual
(λ x x)
@interaction[1
 
             42]