diff --git a/scribble-lib/scribble/private/doc-begin.rkt b/scribble-lib/scribble/private/doc-begin.rkt index c41e555a0c..e7e51f2e77 100644 --- a/scribble-lib/scribble/private/doc-begin.rkt +++ b/scribble-lib/scribble/private/doc-begin.rkt @@ -66,22 +66,15 @@ #'(check-pre-part s (quote-syntax loc))))])) (define (check-pre-part v loc-stx) - (if (pre-part? v) - v - (error - (format - "~a: not valid in document body (need a pre-part for decode) in: ~e" - (cond - [(and (syntax-source loc-stx) - (syntax-line loc-stx)) - (format "~a:~a:~a" - (syntax-source loc-stx) - (syntax-line loc-stx) - (syntax-column loc-stx))] - [(and (syntax-source loc-stx) - (syntax-position loc-stx)) - (format "~a:::~a" - (syntax-source loc-stx) - (syntax-position loc-stx))] - [else 'document]) - v)))) + (unless (pre-part? v) + (error + (format + "~a: not valid in document body (need a pre-part for decode) in: ~e" + (cond + [(and (syntax-source loc-stx) (syntax-line loc-stx)) + (format "~a:~a:~a" (syntax-source loc-stx) (syntax-line loc-stx) (syntax-column loc-stx))] + [(and (syntax-source loc-stx) (syntax-position loc-stx)) + (format "~a:::~a" (syntax-source loc-stx) (syntax-position loc-stx))] + [else 'document]) + v))) + v) diff --git a/scribble-lib/scribble/private/manual-bib.rkt b/scribble-lib/scribble/private/manual-bib.rkt index d7694520cf..39ef0fca8e 100644 --- a/scribble-lib/scribble/private/manual-bib.rkt +++ b/scribble-lib/scribble/private/manual-bib.rkt @@ -11,18 +11,21 @@ (define-struct a-bib-entry (key val)) -(provide/contract - [cite ((string?) () #:rest (listof string?) . ->* . element?)] - [bib-entry ((#:key string? #:title (or/c #f pre-content?)) - (#:is-book? boolean? #:author (or/c #f pre-content?) - #:location (or/c #f pre-content?) - #:date (or/c #f pre-content?) - #:url (or/c #f pre-content?) - #:note (or/c #f pre-content?)) - . ->* . - a-bib-entry?)] - [rename a-bib-entry? bib-entry? predicate/c] - [bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)]) +(provide (contract-out + [cite ((string?) () #:rest (listof string?) . ->* . element?)] + [bib-entry + ((#:key string? #:title (or/c #f pre-content?)) (#:is-book? boolean? + #:author (or/c #f pre-content?) + #:location (or/c #f pre-content?) + #:date (or/c #f pre-content?) + #:url (or/c #f pre-content?) + #:note (or/c #f pre-content?)) + . ->* . + a-bib-entry?)] + (rename a-bib-entry? + bib-entry? + predicate/c) + [bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)])) (define (cite key . keys) (make-element @@ -65,7 +68,9 @@ `(" " ,@(decode-content (list location)) ,(if date "," ".")) null) (if date `(" " ,@(decode-content (list date)) ".") null) - (if url `(" " ,(link url (tt url))) null) + (if url (list " " + (link url + (tt url))) null) (if note (decode-content (list note)) null))))) (define-on-demand bib-style (make-style "RBibliography" scheme-properties)) @@ -81,12 +86,10 @@ (list (make-table bib-style - (map (lambda (c) - (define key (a-bib-entry-key c)) - (define val (a-bib-entry-val c)) - (list - (to-flow (make-target-element #f `("[" ,key "]") `(cite ,key))) + (for/list ([c (in-list citations)]) + (define key (a-bib-entry-key c)) + (define val (a-bib-entry-val c)) + (list (to-flow (make-target-element #f `("[" ,key "]") `(cite ,key))) flow-spacer - (to-flow val))) - citations)))) + (to-flow val)))))) null)) diff --git a/scribble-lib/scribble/private/manual-bind.rkt b/scribble-lib/scribble/private/manual-bind.rkt index fb8b9962df..58cba2d134 100644 --- a/scribble-lib/scribble/private/manual-bind.rkt +++ b/scribble-lib/scribble/private/manual-bind.rkt @@ -59,10 +59,7 @@ (define hovers (make-weak-hasheq)) (define (intern-hover-style text) (let ([text (datum-intern-literal text)]) - (or (hash-ref hovers text #f) - (let ([s (make-style #f (list (make-hover-property text)))]) - (hash-set! hovers text s) - s)))) + (hash-ref! hovers text (λ () (make-style #f (list (make-hover-property text))))))) (define (annote-exporting-library e) (make-delayed-element @@ -71,15 +68,14 @@ (if (and from (pair? from)) (make-element (intern-hover-style - (string-append - "Provided from: " - (string-join (map ~s from) ", ") - (let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))]) - (if (and from-pkgs (pair? from-pkgs)) - (string-append - " | Package: " - (string-join (map ~a from-pkgs) ", ")) - "")))) + (string-join (map ~s from) + ", " + #:before-first "Provided from: " + #:after-last + (let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))]) + (if (and from-pkgs (pair? from-pkgs)) + (string-append " | Package: " (string-join (map ~a from-pkgs) ", ")) + "")))) e) e)) (lambda () e) @@ -114,30 +110,30 @@ (lambda (x add) x))) (let ([lib (or (for/or ([lib (in-list (or source-libs null))]) - (let ([checker - (hash-ref - checkers lib - (lambda () - (define ns-id - (let ([ns (make-base-empty-namespace)]) - (parameterize ([current-namespace ns]) - ;; A `(namespace-require `(for-label ,lib))` can - ;; fail if `lib` provides different bindings of the - ;; same name at different phases. We can require phases - ;; 1 and 0 separately, in which case the phase-0 - ;; binding shadows the phase-1 one in that case. - ;; This strategy only works for documenting bindings - ;; at phases 0 and 1, though. - (namespace-require `(just-meta 1 (for-label ,lib))) - (namespace-require `(just-meta 0 (for-label ,lib))) - (namespace-syntax-introduce (datum->syntax #f 'x))))) - (define (checker id intro) - (free-label-identifier=? - (intro (datum->syntax ns-id (syntax-e id)) 'add) - (intro id 'add))) - (hash-set! checkers lib checker) - checker))]) - (and (checker id intro) lib))) + (define checker + (hash-ref checkers + lib + (lambda () + (define ns-id + (let ([ns (make-base-empty-namespace)]) + (parameterize ([current-namespace ns]) + ;; A `(namespace-require `(for-label ,lib))` can + ;; fail if `lib` provides different bindings of the + ;; same name at different phases. We can require phases + ;; 1 and 0 separately, in which case the phase-0 + ;; binding shadows the phase-1 one in that case. + ;; This strategy only works for documenting bindings + ;; at phases 0 and 1, though. + (namespace-require `(just-meta 1 (for-label ,lib))) + (namespace-require `(just-meta 0 (for-label ,lib))) + (namespace-syntax-introduce (datum->syntax #f 'x))))) + (define (checker id intro) + (free-label-identifier=? (intro (datum->syntax ns-id (syntax-e id)) + 'add) + (intro id 'add))) + (hash-set! checkers lib checker) + checker))) + (and (checker id intro) lib)) (and (pair? libs) (car libs)))]) (and lib (module-path-index->taglet (module-path-index-join lib #f))))) @@ -198,79 +194,64 @@ #:show-libs? [show-libs? #t]) ;; This function could have more optional argument to select ;; whether to index the id, include a toc link, etc. - (let ([dep? #t]) - (define maker - (if form? - (id-to-form-target-maker id dep?) - (id-to-target-maker id dep?))) - (define-values (elem elem-ref) - (if show-libs? - (definition-site (syntax-e id) id form?) - (values (to-element id #:defn? #t) - (to-element id)))) - (if maker - (maker elem - (lambda (tag) - (let ([elem - (if index? - (make-index-element - #f (list elem) tag - (list (datum-intern-literal (symbol->string (syntax-e id)))) - (list elem) - (and show-libs? - (with-exporting-libraries - (lambda (libs) - (make-exported-index-desc (syntax-e id) - libs))))) - elem)]) - (make-target-element #f (list elem) tag)))) - elem))) + (define dep? #t) + (define maker + (if form? + (id-to-form-target-maker id dep?) + (id-to-target-maker id dep?))) + (define-values (elem elem-ref) + (if show-libs? + (definition-site (syntax-e id) id form?) + (values (to-element id #:defn? #t) (to-element id)))) + (if maker + (maker elem + (lambda (tag) + (let ([elem (if index? + (make-index-element + #f + (list elem) + tag + (list (datum-intern-literal (symbol->string (syntax-e id)))) + (list elem) + (and show-libs? + (with-exporting-libraries + (lambda (libs) (make-exported-index-desc (syntax-e id) libs))))) + elem)]) + (make-target-element #f (list elem) tag)))) + elem)) (define (make-binding-redirect-elements mod-path redirects) (define taglet (module-path-index->taglet (module-path-index-join mod-path #f))) (make-element #f - (map - (lambda (redirect) - (define id (car redirect)) - (define form? (cadr redirect)) - (define path (caddr redirect)) - (define anchor (cadddr redirect)) - (define (make-one kind) - (make-redirect-target-element - #f - null - (intern-taglet (list kind (list taglet id))) - path - anchor)) - (make-element - #f - (list (make-one (if form? 'form 'def)) - (make-dep (list taglet id) null) - (let ([str (datum-intern-literal (symbol->string id))]) - (make-index-element #f - null - (intern-taglet - (list (if form? 'form 'def) - (list taglet id))) - (list str) - (list - (make-element - symbol-color - (list - (make-element - (if form? - syntax-link-color - value-link-color) - (list str))))) - (make-exported-index-desc* - id - (list mod-path) - (hash 'kind (if form? - "syntax" - "procedure")))))))) - redirects))) + (for/list ([redirect (in-list redirects)]) + (define id (car redirect)) + (define form? (cadr redirect)) + (define path (caddr redirect)) + (define anchor (cadddr redirect)) + (define (make-one kind) + (make-redirect-target-element #f + null + (intern-taglet (list kind (list taglet id))) + path + anchor)) + (make-element + #f + (list (make-one (if form? 'form 'def)) + (make-dep (list taglet id) null) + (let ([str (datum-intern-literal (symbol->string id))]) + (make-index-element + #f + null + (intern-taglet (list (if form? 'form 'def) (list taglet id))) + (list str) + (list (make-element symbol-color + (list (make-element (if form? syntax-link-color value-link-color) + (list str))))) + (make-exported-index-desc* id + (list mod-path) + (hash 'kind (if form? "syntax" "procedure")))))))))) (define (make-dep t content) diff --git a/scribble-lib/scribble/private/manual-form.rkt b/scribble-lib/scribble/private/manual-form.rkt index e3a4abd106..17c6879418 100644 --- a/scribble-lib/scribble/private/manual-form.rkt +++ b/scribble-lib/scribble/private/manual-form.rkt @@ -413,11 +413,12 @@ flow-empty-line flow-empty-line) (list (to-flow nonterm) flow-empty-line (to-flow "=") flow-empty-line (make-flow (list (car clauses)))) - (map (lambda (clause) - (list flow-empty-line flow-empty-line - (to-flow "|") flow-empty-line - (make-flow (list clause)))) - (cdr clauses)))) + (for/list ([clause (in-list (cdr clauses))]) + (list flow-empty-line + flow-empty-line + (to-flow "|") + flow-empty-line + (make-flow (list clause)))))) nonterms clauseses)))) (define (*racketrawgrammar style nonterm clause1 . clauses) @@ -426,11 +427,8 @@ (define (*racketgrammar lits s-expr clauseses-thunk) (define l (clauseses-thunk)) (*racketrawgrammars #f - (map (lambda (x) - (make-element #f - (list (hspace 2) - (car x)))) - l) + (for/list ([x (in-list l)]) + (make-element #f (list (hspace 2) (car x)))) (map cdr l))) (define (*var id) @@ -445,14 +443,11 @@ (append (list (list flow-empty-line)) (list (list (make-flow - (map (lambda (c) - (make-table - "argcontract" - (list - (list (to-flow (hspace 2)) - (to-flow ((car c))) - flow-spacer - (to-flow ":") - flow-spacer - (make-flow (list ((cadr c)))))))) - contract-procs))))))) + (for/list ([c (in-list contract-procs)]) + (make-table "argcontract" + (list (list (to-flow (hspace 2)) + (to-flow ((car c))) + flow-spacer + (to-flow ":") + flow-spacer + (make-flow (list ((cadr c)))))))))))))) diff --git a/scribble-lib/scribble/private/manual-tech.rkt b/scribble-lib/scribble/private/manual-tech.rkt index f36103662e..a1870662b8 100644 --- a/scribble-lib/scribble/private/manual-tech.rkt +++ b/scribble-lib/scribble/private/manual-tech.rkt @@ -9,28 +9,31 @@ "manual-utils.rkt" "manual-style.rkt") -(provide/contract - [deftech (() (#:normalize? any/c - #:style? any/c - #:key (or/c string? #f) - #:index-extras desc-extras/c) - #:rest (listof pre-content?) . ->* . element?)] - [tech (() - (#:doc (or/c module-path? #f) - #:tag-prefixes (or/c (listof string?) #f) - #:key (or/c string? #f) - #:normalize? any/c - #:indirect? any/c) - #:rest (listof pre-content?) - . ->* . element?)] - [techlink (() - (#:doc (or/c module-path? #f) - #:tag-prefixes (or/c (listof string?) #f) - #:key (or/c string? #f) - #:normalize? any/c - #:indirect? any/c) - #:rest (listof pre-content?) - . ->* . element?)]) +(provide (contract-out + [deftech + (() + (#:normalize? any/c #:style? any/c #:key (or/c string? #f) #:index-extras desc-extras/c) + #:rest (listof pre-content?) + . ->* . + element?)] + [tech + (() (#:doc (or/c module-path? #f) + #:tag-prefixes (or/c (listof string?) #f) + #:key (or/c string? #f) + #:normalize? any/c + #:indirect? any/c) + #:rest (listof pre-content?) + . ->* . + element?)] + [techlink + (() (#:doc (or/c module-path? #f) + #:tag-prefixes (or/c (listof string?) #f) + #:key (or/c string? #f) + #:normalize? any/c + #:indirect? any/c) + #:rest (listof pre-content?) + . ->* . + element?)])) (define (*tech make-elem style doc prefix s key normalize?) (let* ([c (decode-content s)] diff --git a/scribble-lib/scribble/private/manual-unit.rkt b/scribble-lib/scribble/private/manual-unit.rkt index 5af549ec24..c4b3e6ed1d 100644 --- a/scribble-lib/scribble/private/manual-unit.rkt +++ b/scribble-lib/scribble/private/manual-unit.rkt @@ -35,8 +35,7 @@ (define (signature-desc . l) (make-sig-desc l)) -(provide/contract - [signature-desc (() () #:rest (listof pre-flow?) . ->* . sig-desc?)]) +(provide (contract-out [signature-desc (-> pre-flow? ... sig-desc?)])) (define (*defsignature stx-id supers body-thunk indent?) (*defthing diff --git a/scribble-lib/scribble/private/manual-utils.rkt b/scribble-lib/scribble/private/manual-utils.rkt index a42e3fa2c8..8057f09afc 100644 --- a/scribble-lib/scribble/private/manual-utils.rkt +++ b/scribble-lib/scribble/private/manual-utils.rkt @@ -8,14 +8,15 @@ racket/list) (provide doc-prefix) -(provide/contract - [spacer element?] - [to-flow (content? . -> . flow?)] - [flow-spacer flow?] - [flow-spacer/n (-> exact-nonnegative-integer? flow?)] - [flow-empty-line flow?] - [make-table-if-necessary ((or/c style? string?) list? . -> . (list/c (or/c omitable-paragraph? table?)))] - [current-display-width (parameter/c exact-nonnegative-integer?)]) +(provide (contract-out + [spacer element?] + [to-flow (content? . -> . flow?)] + [flow-spacer flow?] + [flow-spacer/n (-> exact-nonnegative-integer? flow?)] + [flow-empty-line flow?] + [make-table-if-necessary + ((or/c style? string?) list? . -> . (list/c (or/c omitable-paragraph? table?)))] + [current-display-width (parameter/c exact-nonnegative-integer?)])) (define spacer (hspace 1)) diff --git a/scribble-test/tests/scribble/markdown.rkt b/scribble-test/tests/scribble/markdown.rkt index 8cc7dd7033..cb16eb657a 100644 --- a/scribble-test/tests/scribble/markdown.rkt +++ b/scribble-test/tests/scribble/markdown.rkt @@ -10,14 +10,14 @@ "scribble-docs-tests")) (define (build-markdown-doc src-file dest-file) - (let* ([renderer (new (markdown:render-mixin render%) [dest-dir work-dir])] - [docs (list (dynamic-require src-file 'doc))] - [fns (list (build-path work-dir dest-file))] - [fp (send renderer traverse docs fns)] - [info (send renderer collect docs fns fp)] - [r-info (send renderer resolve docs fns info)]) - (send renderer render docs fns r-info) - (send renderer get-undefined r-info))) + (define renderer (new (markdown:render-mixin render%) [dest-dir work-dir])) + (define docs (list (dynamic-require src-file 'doc))) + (define fns (list (build-path work-dir dest-file))) + (define fp (send renderer traverse docs fns)) + (define info (send renderer collect docs fns fp)) + (define r-info (send renderer resolve docs fns info)) + (send renderer render docs fns r-info) + (send renderer get-undefined r-info)) (provide markdown-tests) (module+ main (markdown-tests)) @@ -40,11 +40,9 @@ (define (contents file) (regexp-replace #rx"\n+$" (file->string file) "")) (define undefineds (build-markdown-doc src-file "gen.md")) - (for ([u (in-list undefineds)]) - (when (eq? 'tech (car u)) - (test #:failure-message - (format "undefined tech: ~e" u) - #f))) + (for ([u (in-list undefineds)] + #:when (eq? 'tech (car u))) + (test #:failure-message (format "undefined tech: ~e" u) #f)) (test #:failure-message (format "mismatch for: \"~a\", expected text in: \"~a\", got:\n~a" diff --git a/scribble-test/tests/scribble/reader.rkt b/scribble-test/tests/scribble/reader.rkt index 1fa756db15..ed0627b692 100644 --- a/scribble-test/tests/scribble/reader.rkt +++ b/scribble-test/tests/scribble/reader.rkt @@ -947,14 +947,14 @@ END-OF-TESTS (define m (or (regexp-match #px"^(.*)\n\\s*(-\\S+->)\\s*\n(.*)$" t) (regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$" t))) - (if (not (and m (= 4 (length m)))) - (error 'bad-test "~a" t) - (let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))]) - (test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s" - (regexp-replace* #rx"\n" t "\n ") - x - y) - (matching? x y))))))) + (unless (and m (= 4 (length m))) + (error 'bad-test "~a" t)) + (let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))]) + (test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s" + (regexp-replace* #rx"\n" t "\n ") + x + y) + (matching? x y)))))) ;; Check static versus dynamic readtable for command (dynamic when "c" in the ;; name) and datum (dynamic when "d" in the name) parts: diff --git a/scribble-test/tests/scribble/text-lang.rkt b/scribble-test/tests/scribble/text-lang.rkt index 364821b279..1f886cb469 100644 --- a/scribble-test/tests/scribble/text-lang.rkt +++ b/scribble-test/tests/scribble/text-lang.rkt @@ -67,4 +67,4 @@ (call-with-trusted-sandbox-configuration (lambda () (for ([t (in-list (doc:tests))]) - (begin (apply text-test t)))))) + (apply text-test t)))))