diff --git a/collects/scribble/private/manual-code.rkt b/collects/scribble/private/manual-code.rkt index 8eb052b4..308f3be6 100644 --- a/collects/scribble/private/manual-code.rkt +++ b/collects/scribble/private/manual-code.rkt @@ -25,7 +25,10 @@ #:defaults ([keep-lang-line?-expr #'#t]) #:name "#:keep-lang-line? keyword") (~optional (~seq #:context context-expr:expr) - #:name "#:context keyword")) + #:name "#:context keyword") + (~optional (~seq #:line-numbers line-numbers:expr) + #:defaults ([line-numbers #'#f]) + #:name "#:line-numbers keyword")) ...) str ...) #`(typeset-code str ... @@ -38,7 +41,8 @@ (let ([v #'(str ...)]) (and (pair? (syntax-e v)) #`#'#,(car (syntax-e v)))) - #'#f)))])) + #'#f)) + #:line-numbers line-numbers)])) (define (code-inset p) (make-nested-flow (make-style 'code-inset '()) (list p))) @@ -50,6 +54,7 @@ #:expand [expand #f] #:indent [indent 2] #:keep-lang-line? [keep-lang-line? #t] + #:line-numbers [line-numbers #f] . strs) (let* ([str (apply string-append strs)] [bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))] @@ -157,6 +162,7 @@ ((if keep-lang-line? values cdr) ; FIXME: #lang can span lines (list->lines indent + #:line-numbers line-numbers (let loop ([pos 0] [tokens tokens]) (cond @@ -203,19 +209,37 @@ (define omitable (make-style #f '(omitable))) -(define (list->lines indent-amt l) - (define (make-line accum-line) (list (paragraph omitable - (cons indent-elem - (reverse accum-line))))) +(define (list->lines indent-amt l #:line-numbers [line-numbers #f]) (define indent-elem (if (zero? indent-amt) "" (hspace indent-amt))) - (let loop ([l l] [accum-line null]) - (cond - [(null? l) (if (null? accum-line) - null - (list (make-line accum-line)))] - [(eq? 'newline (car l)) - (cons (make-line accum-line) - (loop (cdr l) null))] - [else (loop (cdr l) (cons (car l) accum-line))]))) + ;(list of any) delim -> (list of (list of any)) + (define (break-list lst delim) + (let loop ([l lst] [n null] [c null]) + (cond + [(null? l) (reverse (if (null? c) n (cons (reverse c) n)))] + [(eq? delim (car l)) (loop (cdr l) (cons (reverse c) n) null)] + [else (loop (cdr l) n (cons (car l) c) )]))) + + (define lines (break-list l 'newline)) + (define line-cnt (length lines)) + (define line-cntl (string-length (format "~a" (+ line-cnt (or line-numbers 0))))) + + (define (prepend-line-number n r) + (define ln (format "~a" n)) + (define lnl (string-length ln)) + (define diff (- line-cntl lnl)) + (define l1 (list (tt ln) (hspace 1))) + (cons (make-element 'smaller (make-element 'smaller + (if (not (zero? diff)) (cons (hspace diff) l1) l1))) r)) + + (define (make-line accum-line line-number) + (define rest (cons indent-elem accum-line)) + (list (paragraph omitable (if line-numbers + (prepend-line-number line-number rest) + rest)))) + + (for/list ([l (break-list l 'newline)] + [i (in-naturals (or line-numbers 1))]) + (make-line l i))) + diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 6cd220e9..d69786ce 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -34,11 +34,13 @@ includes a @racket[latex-defaults] @tech{style property}. ([option (code:line #:keep-lang-line? keep-expr) (code:line #:indent indent-expr) (code:line #:expand expand-expr) - (code:line #:context context-expr)]) + (code:line #:context context-expr) + (code:line #:w/line-numbers line-number-expr)]) #:contracts ([keep-expr any/c] [indent-expr exact-nonnegative-integer?] [expand-expr (or/c #f (syntax-object? . -> . syntax-object?))] - [context-expr syntax-object?])]{ + [context-expr syntax-object?] + [line-number-expr (or/c #f exact-nonnegative-integer?)])]{ Parses the code formed by the strings produced by the @racket[str-expr]s as a Racket module (roughly) and produces a @@ -64,6 +66,8 @@ identifiers in the typeset code are colored and linked based on for-label bindings in the lexical environment of the syntax object provided by @racket[context-expr]. The default @racket[context-expr] has the same lexical context as the first @racket[str-expr]. +When @racket[line-number-expr] is true, line number is enabled starting +from @racket[line-number-expr]. When @racket[expand-expr] produces a procedure, it is used to macro-expand the parsed program, and syntax coloring is based on the