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, <mfl...@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 <mfl...@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["|{"]...@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} > > +...@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 > +...@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 > +...@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, > + > +...@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 <j...@cs.byu.edu> Assistant Professor / Brigham Young University http://teammccarthy.org/jay "The glory of God is Intelligence" - D&C 93 _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev