[racket-dev] [plt] Push #21390: master branch updated
This broke the mz-bin distribution, because it added the syntax
colorer to Scribble's dependencies:
http://drdr.racket-lang.org/21390/collects/meta/check-dists.rkt
Jay
On Sun, Oct 31, 2010 at 7:39 AM, <mflatt at racket-lang.org> wrote:
> mflatt has updated `master' from 17f1230bba to aa7c4b53d9.
> http://git.racket-lang.org/plt/17f1230bba..aa7c4b53d9
>
> =====[ 1 Commits ]======================================================
>
> Directory summary:
> 76.1% collects/scribble/private/
> 23.1% collects/scribblings/scribble/
>
> ~~~~~~~~~~
>
> aa7c4b5 Matthew Flatt <mflatt at racket-lang.org> 2010-10-31 07:07
> :
> | add `codeblock' to Scribble
> :
> M collects/scribble/manual.rkt | 2 +
> A collects/scribble/private/manual-code.rkt
> M collects/scribblings/scribble/how-to-paper.scrbl | 32 +++++++-----
> M collects/scribblings/scribble/manual.scrbl | 54 +++++++++++++++++++
>
> =====[ Overall Diff ]===================================================
>
> collects/scribble/manual.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribble/manual.rkt
> +++ NEW/collects/scribble/manual.rkt
> @@ -2,6 +2,7 @@
> (require "base.ss"
> "private/manual-style.ss"
> "private/manual-scheme.ss"
> + "private/manual-code.ss"
> "private/manual-mod.ss"
> "private/manual-tech.ss"
> "private/manual-bib.ss"
> @@ -18,6 +19,7 @@
> (all-from-out "base.ss"
> "private/manual-style.ss"
> "private/manual-scheme.ss"
> + "private/manual-code.ss"
> "private/manual-mod.ss"
> "private/manual-tech.ss"
> "private/manual-bib.ss"
>
> collects/scribble/private/manual-code.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- /dev/null
> +++ NEW/collects/scribble/private/manual-code.rkt
> @@ -0,0 +1,194 @@
> +#lang racket/base
> +(require syntax/strip-context
> + syntax-color/module-lexer
> + "../racket.rkt"
> + "../core.rkt"
> + "../base.rkt"
> + "manual-scheme.rkt"
> + (for-syntax racket/base
> + syntax/parse))
> +
> +(provide codeblock
> + typeset-code)
> +
> +(define-syntax (codeblock stx)
> + (syntax-parse stx
> + [(_ (~seq (~or (~optional (~seq #:expand expand-expr:expr)
> + #:defaults ([expand-expr #'#f])
> + #:name "#:expand keyword")
> + (~optional (~seq #:indent indent-expr:expr)
> + #:defaults ([indent-expr #'2])
> + #:name "#:expand keyword")
> + (~optional (~seq #:keep-lang-line? keep-lang-line?-expr:expr)
> + #:defaults ([keep-lang-line?-expr #'#t])
> + #:name "#:keep-lang-line? keyword")
> + (~optional (~seq #:context context-expr:expr)
> + #:name "#:context keyword"))
> + ...)
> + str ...)
> + #`(typeset-code str ...
> + #:expand expand-expr
> + #:keep-lang-line? keep-lang-line?-expr
> + #:indent indent-expr
> + #:context #,(if (attribute context-expr)
> + #'context-expr
> + (or
> + (let ([v #'(str ...)])
> + (and (pair? (syntax-e v))
> + #`#'#,(car (syntax-e v))))
> + #'#f)))]))
> +
> +(define (typeset-code #:context [context #f]
> + #:expand [expand #f]
> + #:indent [indent 2]
> + #:keep-lang-line? [keep-lang-line? #t]
> + . strs)
> + (let* ([str (apply string-append strs)]
> + [bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))]
> + [in (open-input-bytes bstr)])
> + (let* ([tokens
> + (let loop ([mode #f])
> + (let-values ([(lexeme type data start end backup-delta mode)
> + (module-lexer in 0 mode)])
> + (if (eof-object? lexeme)
> + null
> + (cons (list type (sub1 start) (sub1 end) 0)
> + (loop mode)))))]
> + [substring* (lambda (bstr start [end (bytes-length bstr)])
> + (bytes->string/utf-8 (subbytes bstr start end)))]
> + [e (parameterize ([read-accept-reader #t])
> + ((or expand
> + (lambda (stx)
> + (if context
> + (replace-context context stx)
> + stx)))
> + (read-syntax 'prog (open-input-bytes bstr))))]
> + [ids (let loop ([e e])
> + (cond
> + [(and (identifier? e)
> + (syntax-original? e))
> + (let ([pos (sub1 (syntax-position e))])
> + (list (list (to-element e)
> + pos
> + (+ pos (syntax-span e))
> + 1)))]
> + [(syntax? e) (append (loop (syntax-e e))
> + (loop (or (syntax-property e 'origin)
> + null))
> + (loop (or (syntax-property e 'disappeared-use)
> + null)))]
> + [(pair? e) (append (loop (car e)) (loop (cdr e)))]
> + [else null]))]
> + [link-mod (lambda (mp-stx priority #:orig? [always-orig? #f])
> + (if (or always-orig?
> + (syntax-original? mp-stx))
> + (let ([mp (syntax->datum mp-stx)]
> + [pos (sub1 (syntax-position mp-stx))])
> + (list (list (racketmodname #,mp)
> + pos
> + (+ pos (syntax-span mp-stx))
> + priority)))
> + null))]
> + ;; This makes sense when `expand' actually expands, and
> + ;; probably not otherwise:
> + [mods (let loop ([e e])
> + (syntax-case e (module require begin)
> + [(module name lang (mod-beg form ...))
> + (apply append
> + (link-mod #'lang 2)
> + (map loop (syntax->list #'(form ...))))]
> + [(#%require spec ...)
> + (apply append
> + (map (lambda (spec)
> + ;; Need to add support for renaming forms, etc.:
> + (if (module-path? (syntax->datum spec))
> + (link-mod spec 2)
> + null))
> + (syntax->list #'(spec ...))))]
> + [(begin form ...)
> + (apply append
> + (map loop (syntax->list #'(form ...))))]
> + [else null]))]
> + [language (if (regexp-match? #rx"^#lang " bstr)
> + (let ([m (regexp-match #rx"^#lang ([-a-zA-Z/._+]+)" bstr)])
> + (if m
> + (link-mod
> + #:orig? #t
> + (datum->syntax #f
> + (string->symbol (bytes->string/utf-8 (cadr m)))
> + (vector 'in 1 6 7 (bytes-length (cadr m))))
> + 3)
> + null))
> + null)]
> + [tokens (sort (append ids
> + mods
> + language
> + (filter (lambda (x) (not (eq? (car x) 'symbol)))
> + ;; Drop #lang entry:
> + (cdr tokens)))
> + (lambda (a b)
> + (or (< (cadr a) (cadr b))
> + (and (= (cadr a) (cadr b))
> + (> (cadddr a) (cadddr b))))))]
> + [default-color meta-color])
> + (table
> + block-color
> + ((if keep-lang-line? values cdr) ; FIXME: #lang can span lines
> + (list->lines
> + indent
> + (let loop ([pos 0]
> + [tokens tokens])
> + (cond
> + [(null? tokens) (split-lines default-color (substring* bstr pos))]
> + [(eq? (caar tokens) 'white-space) (loop pos (cdr tokens))]
> + [(= pos (cadar tokens))
> + (append (let ([style (caar tokens)])
> + (if (symbol? style)
> + (let ([scribble-style
> + (case style
> + [(symbol) symbol-color]
> + [(parenthesis) paren-color]
> + [(constant string) value-color]
> + [(comment) comment-color]
> + [else default-color])])
> + (split-lines scribble-style
> + (substring* bstr (cadar tokens) (caddar tokens))))
> + (list (caar tokens))))
> + (loop (caddar tokens) (cdr tokens)))]
> + [(> pos (cadar tokens))
> + (loop pos (cdr tokens))]
> + [else (append
> + (split-lines default-color (substring* bstr pos (cadar tokens)))
> + (loop (cadar tokens) tokens))]))))))))
> +
> +
> +(define (split-lines style s)
> + (cond
> + [(regexp-match-positions #rx"(?:\r\n|\r|\n)" s)
> + => (lambda (m)
> + (list* (element style (substring s 0 (caar m)))
> + 'newline
> + (split-lines style (substring s (cdar m)))))]
> + [(regexp-match-positions #rx" +" s)
> + => (lambda (m)
> + (append (split-lines style (substring s 0 (caar m)))
> + (list (hspace (- (cdar m) (caar m))))
> + (split-lines style (substring s (cdar m)))))]
> + [else (list (element style s))]))
> +
> +(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 indent-elem (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))])))
>
> collects/scribblings/scribble/how-to-paper.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/scribble/how-to-paper.scrbl
> +++ NEW/collects/scribblings/scribble/how-to-paper.scrbl
> @@ -2,9 +2,15 @@
> @(require scribble/manual
> scribble/bnf
> "utils.ss"
> - (for-label scriblib/figure))
> -
> -@(define (sample . text) (nested #:style 'inset (apply verbatim text)))
> + (for-label scriblib/figure
> + scribble/base
> + scribble/sigplan))
> +
> +@(define-syntax-rule (samplemod . text) (codeblock . text))
> +@(define-syntax-rule (sample a . text) (codeblock #:context #'a
> + #:keep-lang-line? #f
> + "#lang scribble/base" "\n"
> + a . text))
> @(define (result . text) (apply nested #:style 'inset text))
>
> @title[#:tag "getting-started"]{Getting Started}
> @@ -18,7 +24,7 @@ goal-specific advice on how to continue.
>
> Create a file @filepath{mouse.scrbl} with this content:
>
> - @sample|{
> + @samplemod|{
> #lang scribble/base
>
> @title{On the Cookie-Eating Habits of Mice}
> @@ -65,7 +71,7 @@ for the kind of document that you want as output:
>
> Add more text to @filepath{mouse.scrbl} so that it looks like this:
>
> - @sample|{
> + @samplemod|{
> #lang scribble/base
>
> @title{On the Cookie-Eating Habits of Mice}
> @@ -111,7 +117,7 @@ larger document.
> To split the example document into multiple files, change
> @filepath{mouse.scrbl} to just
>
> - @sample|{
> + @samplemod|{
> #lang scribble/base
>
> @title{On the Cookie-Eating Habits of Mice}
> @@ -126,7 +132,7 @@ To split the example document into multiple files, change
> Create @filepath{milk.scrbl} and @filepath{straw.scrbl} in the same
> directory as @filepath{mouse.scrbl}. In @filepath{milk.scrbl}, put
>
> - @sample|{
> + @samplemod|{
> #lang scribble/base
>
> @title{The Consequences of Milk}
> @@ -136,7 +142,7 @@ directory as @filepath{mouse.scrbl}. In @filepath{milk.scrbl}, put
>
> and in @filepath{straw.scbl}, put
>
> - @sample|{
> + @samplemod|{
> #lang scribble/base
>
> @title{Not the Last Straw}
> @@ -167,14 +173,14 @@ the paper to a workshop on programming languages, then---well, you
> probably need a different topic. But you can start making the current
> content look right by changing the first line to
>
> - @sample|{
> + @samplemod|{
> #lang scribble/sigplan
> }|
>
> If you're instead working toward Racket library documentation,
> try changing the first line to
>
> - @sample|{
> + @samplemod|{
> #lang scribble/manual
> }|
>
> @@ -191,7 +197,7 @@ version number---but it changes the set of bindings available in the
> document body. For example, with @racketmodname[scribble/sigplan], the
> introductory text can be marked as an abstract:
>
> - @sample|{
> + @samplemod|{
> #lang scribble/sigplan
>
> @title{On the Cookie-Eating Habits of Mice}
> @@ -573,9 +579,9 @@ renders as
>
> because the source is equivalent to
>
> - @sample|{
> + @racketblock[
> (verbatim (number->string (+ 1 2)))
> - }|
> + ]
>
> where @racket[(number->string (+ 1 2))] is evaluated to produce the
> argument to @racket[verbatim]. The @litchar["|{"]... at litchar["}|"]
>
> collects/scribblings/scribble/manual.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/scribble/manual.scrbl
> +++ NEW/collects/scribblings/scribble/manual.scrbl
> @@ -30,6 +30,60 @@ includes a @racket[latex-defaults] @tech{style property}.
> @; ------------------------------------------------------------------------
> @section[#:tag "scribble:manual:code"]{Typesetting Code}
>
> + at defform/subs[(codeblock option ... str-expr ...+)
> + ([option (code:line #:indent indent-expr)
> + (code:line #:expand expand-expr)
> + (code:line #:context context-expr)
> + (code:line #:keep-lang-line? keep-expr)])
> + #:contracts ([indent-expr exact-nonnegative-integer?]
> + [expand-expr (or/c #f (syntax-object? . -> . syntax-object?))]
> + [context-expr syntax-object?]
> + [keep-expr any/c])]{
> +
> +Parses the code formed by the strings produced by the
> + at racket[str-expr]s as a Racket module and produces a @tech{block} that
> +typesets the code. The code is indented by the amount specified by
> + at racket[indent-expr], which defaults to @racket[2].
> +
> +When @racket[expand-expr] produces @racket[#f] (which is the default),
> +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[expand-expr] produces a procedure, it is used to
> +macro-expand the parsed program, and syntax coloring is based on the
> +parsed program.
> +
> +When @racket[keep-lang-line?-expr] produces a true value (the
> +default), the @hash-lang[] line in the input is preserved in the
> +typeset output, otherwise the first line is dropped.
> +
> +For example,
> +
> + at codeblock[#:keep-lang-line? #f]|<|{
> + #lang scribble/manual
> + @codeblock|{
> + #lang scribble/manual
> + @codeblock{
> + #lang scribble/manual
> + @title{Hello}
> + }
> + }|
> +}|>|
> +
> +produces the typeset result
> +
> + @codeblock|{
> + #lang scribble/manual
> + @codeblock{
> + #lang scribble/manual
> + @title{Hello}
> + }
> + }|
> +
> +}
> +
> @defform[(racketblock datum ...)]{
>
> Typesets the @racket[datum] sequence as a table of Racket code inset
>
--
Jay McCarthy <jay at cs.byu.edu>
Assistant Professor / Brigham Young University
http://teammccarthy.org/jay
"The glory of God is Intelligence" - D&C 93
![[logo]](/logo.png){kind=logo}