codeblock line numbers

original commit: 0c4d90b1db8ce9a01215ac413505314349c852b3

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)))
+

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