diff --git a/collects/compiler/cffi.scrbl b/collects/compiler/cffi.scrbl index a63913ca91..06cfa66e9a 100644 --- a/collects/compiler/cffi.scrbl +++ b/collects/compiler/cffi.scrbl @@ -10,7 +10,7 @@ @(define inside @other-manual['(lib "scribblings/inside/inside.scrbl")]) @(define (lines . l) - (make-table "inlinetop" + (make-table #f (map (lambda (l) (list (make-flow diff --git a/collects/mzlib/scribblings/mzlib.scrbl b/collects/mzlib/scribblings/mzlib.scrbl index 5e5aae0de0..8b5b54c3dd 100644 --- a/collects/mzlib/scribblings/mzlib.scrbl +++ b/collects/mzlib/scribblings/mzlib.scrbl @@ -222,6 +222,14 @@ Re-exports @schememodname[scheme/shared]. @; ---------------------------------------------------------------------- +@include-section["string.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["struct.scrbl"] + +@; ---------------------------------------------------------------------- + @(bibliography (bib-entry #:key "Shivers06" diff --git a/collects/mzlib/scribblings/string.scrbl b/collects/mzlib/scribblings/string.scrbl new file mode 100644 index 0000000000..2853d79123 --- /dev/null +++ b/collects/mzlib/scribblings/string.scrbl @@ -0,0 +1,114 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/string + scheme/contract + (only-in scheme/base + regexp-try-match))) + +@mzlib[#:mode title string] + +The @schememodname[mzlib/string] library re-exports several functions +from @schememodname[scheme/base]: + +@schemeblock[ +real->decimal-string +regexp-quote +regexp-replace-quote +regexp-match* +regexp-match-positions* +regexp-match-peek-positions* +regexp-split +regexp-match-exact? +] + +It also re-exports @scheme[regexp-try-match] as +@scheme[regexp-match/fail-without-reading]. + + +@defproc[(glob->regexp [str (or/c string bytes?)?] + [hide-dots? any/c #t] + [case-sensitive? any/c (eq? (system-path-convention-type)'unix)] + [simple? any/c #f]) + (or/c regexp? byte-regexp?)]{ + +Produces a regexp for a an input ``glob pattern'' @scheme[str]. A +glob pattern is one that matches @litchar{*} with any string, +@litchar{?} with a single character, and character ranges are the same +as in regexps (unless @scheme[simple?] is true). In addition, the +resulting regexp does not match strings that begin with @litchar{.}, +unless @scheme[str] begins with @litchar{.} or @scheme[hide-dots?] is +@scheme[#f]. The resulting regexp can be used with string file names +to check the glob pattern. If the glob pattern is provided as a byte +string, the result is a byte regexp. + +The @scheme[case-sensitive?] argument determines whether the resulting +regexp is case-sensitive. + +If @scheme[simple?] is true, then ranges with +@litchar{[}...@litchar{]} in @scheme[str] are treated as literal +character sequences.} + + +@defproc[(string-lowercase! [str (and/c string? (not/c immutable?))]) void?]{ + +Destructively changes @scheme[str] to contain only lowercase +characters.} + + +@defproc[(string-uppercase! [str (and/c string? (not/c immutable?))]) void?]{ + +Destructively changes @scheme[str] to contain only uppercase +characters.} + + + +@defproc[(eval-string [str (or/c string? bytes?)] + [err-handler (or/c false/c + (any/c . -> . any/c) + (-> any/c)) + #f]) + list?]{ + +Reads and evaluates S-expressions from @scheme[str], returning results +for all of the expressions in the string. If any expression produces +multiple results, the results are spliced into the resulting list. If +@scheme[str] contains only whitespace and comments, an empty list is +returned, and if @scheme[str] contains multiple expressions, the +result will be contain multiple values from all subexpressions. + +The @scheme[err-handler] argument can be: +@itemize{ +@item{@scheme[#f] (the default) which means that errors are not + caught;} +@item{a one-argument procedure, which will be used with an exception + (when an error occurs) and its result will be returned} +@item{a thunk, which will be used to produce a result.} +}} + + +@defproc[(expr->string [expr any/c]) string?]{ + +Prints @scheme[expr] into a string and returns the string.} + + +@defproc[(read-from-string [str (or/c string? bytes?)] + [err-handler (or/c false/c + (any/c . -> . any/c) + (-> any/c)) + #f]) + any/c]{ + +Reads the first S-expression from @scheme[str] and returns it. The +@scheme[err-handler] is as in @scheme[eval-string].} + + +@defproc[(read-from-string-all [str (or/c string? bytes?)] + [err-handler (or/c false/c + (any/c . -> . any/c) + (-> any/c)) + #f]) + list?]{ + +Reads all S-expressions from the string (or byte string) @scheme[str] +and returns them in a list. The @scheme[err-handler] is as in +@scheme[eval-string].} diff --git a/collects/mzlib/scribblings/struct.scrbl b/collects/mzlib/scribblings/struct.scrbl new file mode 100644 index 0000000000..4569ed4e9b --- /dev/null +++ b/collects/mzlib/scribblings/struct.scrbl @@ -0,0 +1,70 @@ +#lang scribble/doc +@(require "common.ss" + scribble/eval + (for-label mzlib/struct + scheme/contract + (only-in scheme/base + regexp-try-match))) + +@(define struct-eval (make-base-eval)) +@interaction-eval[#:eval struct-eval (require mzscheme)] +@interaction-eval[#:eval struct-eval (require mzlib/struct)] + +@mzlib[#:mode title struct] + +@section[#:tag "mzlib:struct"]{Structure Utilities} + +@defform[(copy-struct struct-id struct-expr + (accessor-id field-expr) ...)]{ + +``Functional update'' for structure instances. The result of +evaluating @scheme[struct-expr] must be an instance of the structure +type named by @scheme[struct-id]. The result of the +@scheme[copy-struct] expression is a fresh instance of +@scheme[struct-id] with the same field values as the result of +@scheme[struct-expr], except that the value for the field accessed by +each @scheme[accessor-id] is replaced by the result of +@scheme[field-expr]. + +The result of @scheme[struct-expr] might be an instance of a sub-type +of @scheme[struct-id], but the result of the @scheme[copy-struct] +expression is an immediate instance of @scheme[struct-id]. If +@scheme[struct-expr] does not produce an instance of +@scheme[struct-id], the @scheme[exn:fail:contract] exception is +raised. + +If any @scheme[accessor-id] is not bound to an accessor of +@scheme[struct-id] (according to the expansion-time information +associated with @scheme[struct-id]), or if the same +@scheme[accessor-id] is used twice, then a syntax error is raised.} + + +@defform/subs[(define-struct/properties id (field-id ...) + ((prop-expr val-expr) ...) + maybe-inspector-expr) + ([maybe-inspector-expr code:blank + expr])]{ + +Like @scheme[define-struct] from @schememodname[mzscheme], but +properties can be attached to the structure type. Each +@scheme[prop-expr] should produce a structure-type property value, and +each @scheme[val-expr] produces the corresponding value for the +property. + +@examples[ +#:eval struct-eval +(define-struct/properties point (x y) + ([prop:custom-write (lambda (p port write?) + (fprintf port "(~a, ~a)" + (point-x p) + (point-y p)))])) +(display (make-point 1 2)) +]} + + +@defform[(make->vector struct-id)]{ + +Builds a function that accepts a structure type instance (matching +@scheme[struct-id]) and provides a vector of the fields of the +structure type instance.} + diff --git a/collects/mzlib/string.ss b/collects/mzlib/string.ss index 11076903df..f1b2156a8d 100644 --- a/collects/mzlib/string.ss +++ b/collects/mzlib/string.ss @@ -83,7 +83,7 @@ (define glob->regexp (let-values - ([(def-case-sens) (not (memq (system-type) '(windows macos macosx)))] + ([(def-case-sens) (eq? (system-path-convention-type)'unix)] [(item:s item:b simple-item:s simple-item:b) (let ([rx (lambda (s) (string-append diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index a23cd1603b..d6d841fb73 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -298,7 +298,7 @@ (list (when (part-title-content d) (render-content (part-title-content d) d ri)) - (render-flow (part-flow d) d ri) + (render-flow (part-flow d) d ri #f) (map (lambda (s) (render-part s ri)) (part-parts d)))) @@ -308,36 +308,41 @@ (define/public (render-paragraph p part ri) (render-content (paragraph-content p) part ri)) - (define/public (render-flow p part ri) - (apply append - (map (lambda (p) - (render-flow-element p part ri)) - (flow-paragraphs p)))) + (define/public (render-flow p part ri start-inline?) + (if (null? (flow-paragraphs p)) + null + (append + (render-flow-element (car (flow-paragraphs p)) + part ri start-inline?) + (apply append + (map (lambda (p) + (render-flow-element p part ri #f)) + (cdr (flow-paragraphs p))))))) - (define/public (render-flow-element p part ri) + (define/public (render-flow-element p part ri inline?) (cond [(table? p) (if (auxiliary-table? p) (render-auxiliary-table p part ri) - (render-table p part ri))] + (render-table p part ri inline?))] [(itemization? p) (render-itemization p part ri)] [(blockquote? p) (render-blockquote p part ri)] [(delayed-flow-element? p) - (render-flow-element (delayed-flow-element-flow-elements p ri) part ri)] + (render-flow-element (delayed-flow-element-flow-elements p ri) part ri inline?)] [else (render-paragraph p part ri)])) (define/public (render-auxiliary-table i part ri) null) - (define/public (render-table i part ri) - (map (lambda (d) (if (flow? i) (render-flow d part ri) null)) + (define/public (render-table i part ri inline?) + (map (lambda (d) (if (flow? i) (render-flow d part ri #f) null)) (apply append (table-flowss i)))) (define/public (render-itemization i part ri) - (map (lambda (d) (render-flow d part ri)) + (map (lambda (d) (render-flow d part ri #t)) (itemization-flows i))) (define/public (render-blockquote i part ri) - (map (lambda (d) (render-flow-element d part ri)) + (map (lambda (d) (render-flow-element d part ri #f)) (blockquote-paragraphs i))) (define/public (render-element i part ri) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 674f166805..2cd3552d5e 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -331,7 +331,7 @@ (map (lambda (t) (let loop ([t t]) (if (table? t) - (render-table t d ri) + (render-table t d ri #f) (loop (delayed-flow-element-flow-elements t ri))))) (filter (lambda (e) (let loop ([e e]) @@ -620,7 +620,7 @@ ,@(if (part-title-content d) (render-content (part-title-content d) d ri) null))))) - ,@(render-flow* (part-flow d) d ri #f) + ,@(render-flow* (part-flow d) d ri #f #f) ,@(let loop ([pos 1] [secs (part-parts d)]) (if (null? secs) @@ -629,23 +629,23 @@ (render-part (car secs) ri) (loop (add1 pos) (cdr secs)))))))) - (define/private (render-flow* p part ri special-last?) + (define/private (render-flow* p part ri start-inline? special-last?) ;; Wrap each table with

, except for a trailing table ;; when `special-last?' is #t - (let loop ([f (flow-paragraphs p)]) + (let loop ([f (flow-paragraphs p)][inline? start-inline?]) (cond [(null? f) null] [(and (table? (car f)) (or (not special-last?) (not (null? (cdr f))))) - (cons `(p ,@(render-flow-element (car f) part ri)) - (loop (cdr f)))] + (cons `(p ,@(render-flow-element (car f) part ri inline?)) + (loop (cdr f) #f))] [else - (append (render-flow-element (car f) part ri) - (loop (cdr f)))]))) + (append (render-flow-element (car f) part ri inline?) + (loop (cdr f) #f))]))) - (define/override (render-flow p part ri) - (render-flow* p part ri #t)) + (define/override (render-flow p part ri start-inline?) + (render-flow* p part ri start-inline? #t)) (define/override (render-paragraph p part ri) `((p ,@(if (styled-paragraph? p) @@ -751,10 +751,13 @@ [(image-file? style) `((img ((src ,(install-file (image-file-path style))))))] [else (super render-element e part ri)]))) - (define/override (render-table t part ri) + (define/override (render-table t part ri need-inline?) (define index? (eq? 'index (table-style t))) `(,@(if index? `(,search-script ,search-field) '()) (table ((cellspacing "0") + ,@(if need-inline? + '((style "display: inline; vertical-align: top;")) + null) ,@(case (table-style t) [(boxed) '((class "boxed"))] [(centered) '((align "center"))] @@ -810,7 +813,7 @@ [(eq? 'cont (car ds)) (loop (+ n 1) (cdr ds))] [else n]))))) null)) - ,@(render-flow d part ri)) + ,@(render-flow d part ri #f)) (loop (cdr ds) (cdr as) (cdr vas))))))))) (table-flowss t) (cdr (or (and (list? (table-style t)) @@ -823,7 +826,7 @@ null) ,@(apply append (map (lambda (i) - (render-flow-element i part ri)) + (render-flow-element i part ri #f)) (blockquote-paragraphs t)))))) (define/override (render-itemization t part ri) @@ -833,7 +836,7 @@ `(((class ,(styled-itemization-style t)))) null) ,@(map (lambda (flow) - `(li ,@(render-flow flow part ri))) + `(li ,@(render-flow flow part ri #t))) (itemization-flows t))))) (define/override (render-other i part ri) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 5a90c10d08..55e3a0042f 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -113,7 +113,7 @@ (for-each (lambda (t) (printf "\\label{t:~a}" (t-encode (tag-key t ri)))) (part-tags d)) - (render-flow (part-flow d) d ri) + (render-flow (part-flow d) d ri #f) (for-each (lambda (sec) (render-part sec ri)) (part-parts d)) null)) @@ -226,7 +226,7 @@ (format "x~x" (char->integer c))])) (string->list (format "~s" s))))) - (define/override (render-table t part ri) + (define/override (render-table t part ri inline-table?) (let* ([boxed? (eq? 'boxed (table-style t))] [index? (eq? 'index (table-style t))] [inline? (and (not boxed?) @@ -239,7 +239,8 @@ (= 1 (length (car (table-flowss (cadr m))))))))] [tableform (cond [index? "list"] - [(not (current-table-mode)) + [(and (not (current-table-mode)) + (not inline-table?)) "longtable"] [else "tabular"])] [opt (cond @@ -299,7 +300,7 @@ [else n]))]) (unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt)) - (render-flow (car flows) part ri) + (render-flow (car flows) part ri #f) (unless (= cnt 1) (printf "}")) (unless (null? (list-tail flows cnt)) @@ -325,7 +326,7 @@ (printf "\n\n\\begin{itemize}\n") (for-each (lambda (flow) (printf "\n\n\\item ") - (render-flow flow part ri)) + (render-flow flow part ri #t)) (itemization-flows t)) (printf "\n\n\\end{itemize}\n") null) @@ -334,7 +335,7 @@ (printf "\n\n\\begin{quote}\n") (parameterize ([current-table-mode (list "blockquote" t)]) (for-each (lambda (e) - (render-flow-element e part ri)) + (render-flow-element e part ri #f)) (blockquote-paragraphs t))) (printf "\n\n\\end{quote}\n") null) diff --git a/collects/scribble/text-render.ss b/collects/scribble/text-render.ss index 0eb9c59da0..c1fc35f5ce 100644 --- a/collects/scribble/text-render.ss +++ b/collects/scribble/text-render.ss @@ -34,7 +34,7 @@ (part-title-content d)) (newline)) (newline) - (render-flow (part-flow d) d ht) + (render-flow (part-flow d) d ht #f) (let loop ([pos 1] [secs (part-parts d)]) (unless (null? secs) @@ -42,28 +42,28 @@ (render-part (car secs) ht) (loop (add1 pos) (cdr secs)))))) - (define/override (render-flow f part ht) + (define/override (render-flow f part ht start-inline?) (let ([f (flow-paragraphs f)]) (if (null? f) null (apply append - (render-flow-element (car f) part ht) + (render-flow-element (car f) part ht start-inline?) (map (lambda (p) (newline) (newline) - (render-flow-element p part ht)) + (render-flow-element p part ht #f)) (cdr f)))))) - (define/override (render-table i part ht) + (define/override (render-table i part ht inline?) (let ([flowss (table-flowss i)]) (if (null? flowss) null (apply append - (map (lambda (d) (render-flow d part ht)) (car flowss)) + (map (lambda (d) (render-flow d part ht #f)) (car flowss)) (map (lambda (flows) (newline) - (map (lambda (d) (render-flow d part ht)) flows)) + (map (lambda (d) (render-flow d part ht #f)) flows)) (cdr flowss)))))) (define/override (render-itemization i part ht) @@ -73,10 +73,10 @@ (apply append (begin (printf "* ") - (render-flow (car flows) part ht)) + (render-flow (car flows) part ht #t)) (map (lambda (d) (printf "\n\n* ") - (render-flow d part ht)) + (render-flow d part ht #f)) (cdr flows)))))) (define/override (render-other i part ht) diff --git a/collects/scribblings/reference/stx-trans.scrbl b/collects/scribblings/reference/stx-trans.scrbl index 2f9682be76..53b85b2785 100644 --- a/collects/scribblings/reference/stx-trans.scrbl +++ b/collects/scribblings/reference/stx-trans.scrbl @@ -533,7 +533,8 @@ Expands the given @scheme[_require-spec] to lists of imports and import sources.} -@defproc[(make-require-transformer [proc ((syntax?) . ->* . ((listof import?) (listof import-source?)))]) +@defproc[(make-require-transformer [proc ((syntax?) . ->* . ((listof import?) + (listof import-source?)))]) require-transformer?]{ Creates a @deftech{require transformer} (i.e., a structure with the diff --git a/collects/syntax/modcode.ss b/collects/syntax/modcode.ss index be493540e2..5accba40d0 100644 --- a/collects/syntax/modcode.ss +++ b/collects/syntax/modcode.ss @@ -44,7 +44,16 @@ void (lambda () (let ([v (with-module-reading-parameterization - (lambda () (read-syntax path p)))]) + (lambda () + ;; In case we're reading a .zo, we need to set + ;; the load-relative directory for unmarshaling + ;; path literals. + (parameterize ([current-load-relative-directory + (let-values ([(base name dir?) (split-path orig-path)]) + (if (path? base) + base + (current-directory)))]) + (read-syntax path p))))]) (when (eof-object? v) (error 'read-one "empty file; expected a module declaration in: ~a" path))