diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl index 553f5c4c..bfd4e0c1 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl @@ -766,6 +766,7 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].} @defform/subs[(defproc options prototype result-contract-expr-datum + maybe-value pre-flow ...) ([prototype (id arg-spec ...) (prototype arg-spec ...)] @@ -782,6 +783,8 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].} (code:line #:link-target? link-target?-expr)] [maybe-id code:blank (code:line #:id [src-id dest-id-expr])] + [maybe-value code:blank + (code:line #:value value-expr-datum)] [ellipses @#,lit-ellipses] [ellipses+ @#,lit-ellipses+])]{ @@ -895,11 +898,17 @@ If @racket[#:id [src-id dest-id-expr]] is supplied, then place of @racket[src-id]. This split between @racket[src-id] and @racket[dest-id-expr] roles is useful for functional abstraction of @racket[defproc]. + +If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum] +is typeset using @racket[racketblock0] and included in the documentation. +As a service to readers, please use @racket[#:value] to document only +simple, short functions. } @defform[(defproc* options ([prototype - result-contract-expr-datum] ...) + result-contract-expr-datum + maybe-value] ...) pre-flow ...)]{ Like @racket[defproc], but for multiple cases with the same @@ -916,9 +925,8 @@ should use @racket[#:link-target? #f]. Examples: @codeblock[#:keep-lang-line? #f]|{ #lang scribble/manual -@defproc[((make-pb&j) - (make-pb&j [jelly jelly?])) - sandwich?]{ +@defproc*[([(make-pb&j) sandwich?] + [(make-pb&j [jelly jelly?]) sandwich?])]{ Returns a peanut butter and jelly sandwich. If @racket[jelly] is provided, then it is used instead of the standard (grape) jelly. @@ -926,10 +934,9 @@ Examples: }| @doc-render-examples[ - @defproc[#:link-target? #f - ((make-pb&j) - (make-pb&j [jelly jelly?])) - sandwich?]{ + @defproc*[#:link-target? #f + ([(make-pb&j) sandwich?] + [(make-pb&j [jelly jelly?]) sandwich?])]{ Returns a peanut butter and jelly sandwich. If @racket[jelly] is provided, then it is used instead of the standard (grape) jelly. @@ -1221,7 +1228,10 @@ Examples: } -@defform[(defparam maybe-link id arg-id contract-expr-datum pre-flow ...)]{ +@defform[(defparam maybe-link id arg-id + contract-expr-datum + maybe-value + pre-flow ...)]{ Like @racket[defproc], but for a parameter. The @racket[contract-expr-datum] serves as both the result contract on the @@ -1231,22 +1241,24 @@ parameter and the contract on values supplied for the parameter. The Examples: @codeblock[#:keep-lang-line? #f]|{ #lang scribble/manual -@defparam[current-sandwich sandwich sandwich?]{ +@defparam[current-sandwich sandwich sandwich? + #:value empty-sandwich]{ A parameter that defines the current sandwich for operations that - involve eating a sandwich. + involve eating a sandwich. Default value is the empty sandwich. } }| @doc-render-examples[ @defparam[#:link-target? #f - current-sandwich sandwich sandwich?]{ + current-sandwich sandwich sandwich? #:value empty-sandwich]{ A parameter that defines the current sandwich for operations that - involve eating a sandwich. + involve eating a sandwich. Default value is the empty sandwich. }] } @defform[(defparam* maybe-link id arg-id in-contract-expr-datum out-contract-expr-datum + maybe-value pre-flow ...)]{ Like @racket[defparam], but with separate contracts for when the parameter is being @@ -1255,14 +1267,16 @@ coerces values matching a more flexible contract to a more restrictive one; @racket[current-directory] is an example).} -@defform[(defboolparam maybe-link id arg-id pre-flow ...)]{ +@defform[(defboolparam maybe-link id arg-id + maybe-value + pre-flow ...)]{ Like @racket[defparam], but the contract on a parameter argument is @racket[any/c], and the contract on the parameter result is @racket[boolean?].} -@defform/subs[(defthing options id contract-expr-datum +@defform/subs[(defthing options id contract-expr-datum maybe-value pre-flow ...) ([options (code:line maybe-kind maybe-link maybe-id)] [maybe-kind code:blank @@ -1270,7 +1284,9 @@ Like @racket[defparam], but the contract on a parameter argument is [maybe-link code:blank (code:line #:link-target? link-target?-expr)] [maybe-id code:blank - (code:line #:id id-expr)])]{ + (code:line #:id id-expr)] + [maybe-value code:blank + (code:line #:value value-expr-datum)])]{ Like @racket[defproc], but for a non-procedure binding. @@ -1281,17 +1297,29 @@ it is used in the same way as for If @racket[#:id id-expr] is supplied, then the result of @racket[id-expr] is used in place of @racket[id]. +If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum] +is typeset using @racket[racketblock0] and included in the documentation. +Wide values are put on a separate line. + Examples: @codeblock[#:keep-lang-line? #f]|{ #lang scribble/manual @defthing[moldy-sandwich sandwich?]{ Don't eat this. Provided for backwards compatibility. } + +@defthing[empty-sandwich sandwich? #:value (make-sandwich empty)]{ + The empty sandwich. +} }| @doc-render-examples[ @defthing[#:link-target? #f moldy-sandwich sandwich?]{ Don't eat this. Provided for backwards compatibility. + } + @defthing[#:link-target? #f + empty-sandwich sandwich? #:value (make-sandwich empty)]{ + The empty sandwich. }] } diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt index e28c2f63..d11fa7e5 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt @@ -117,12 +117,25 @@ "expected a result contract, found a string" #'c) #'(racketblock0 c))])) +(define no-value #f) + +(define-syntax (result-value stx) + (syntax-case stx (no-value let) + [(_ no-value) #'#f] + [(_ (let () e ...)) #'(racketblock0 e ...)] + [(_ v) #'(racketblock0 v)])) + (begin-for-syntax (define-splicing-syntax-class kind-kw #:description "#:kind keyword" (pattern (~optional (~seq #:kind kind) #:defaults ([kind #'#f])))) + (define-splicing-syntax-class value-kw + #:description "#:value keyword" + (pattern (~optional (~seq #:value value) + #:defaults ([value #'no-value])))) + (define-splicing-syntax-class link-target?-kw #:description "#:link-target? keyword" (pattern (~seq #:link-target? expr)) @@ -152,13 +165,30 @@ (define-syntax (defproc stx) (syntax-parse stx - [(_ kind:kind-kw lt:link-target?-kw i:id-kw (id arg ...) result desc ...) + [(_ kind:kind-kw + lt:link-target?-kw + i:id-kw + (id arg ...) + result + value:value-kw + desc ...) (syntax/loc stx - (defproc* #:kind kind.kind #:link-target? lt.expr #:id [i.key i.expr] [[(id arg ...) result]] desc ...))])) + (defproc* + #:kind kind.kind + #:link-target? lt.expr + #:id [i.key i.expr] + [[(id arg ...) result #:value value.value]] + desc ...))])) (define-syntax (defproc* stx) (syntax-parse stx - [(_ kind:kind-kw lt:link-target?-kw d:id-kw mode:mode-kw within:within-kw [[proto result] ...] desc ...) + [(_ kind:kind-kw + lt:link-target?-kw + d:id-kw + mode:mode-kw + within:within-kw + [[proto result value:value-kw] ...] + desc ...) (syntax/loc stx (with-togetherable-racket-variables () @@ -173,14 +203,15 @@ (list (arg-contracts proto) ...) (list (arg-defaults proto) ...) (list (lambda () (result-contract result)) ...) - (lambda () (list desc ...))))))])) + (lambda () (list desc ...)) + (list (result-value value.value) ...)))))])) (define-struct arg (special? kw id optional? starts-optional? ends-optional? num-closers)) (define (*defproc kind link? mode within-id - stx-ids sym prototypes arg-contractss arg-valss result-contracts - content-thunk) + stx-ids sym prototypes arg-contractss arg-valss result-contracts content-thunk + [result-values (map (lambda (x) #f) result-contracts)]) (define max-proto-width (current-display-width)) (define ((arg->elem show-opt-start?) arg) (let* ([e (cond [(not (arg-special? arg)) @@ -282,7 +313,7 @@ (syntax-e stx-id) (car p))) (loop (car p))))) - (define (do-one stx-id prototype args arg-contracts arg-vals result-contract + (define (do-one stx-id prototype args arg-contracts arg-vals result-contract result-value first? add-background-label?) (let ([names (remq* '(... ...+) (map arg-id args))]) (unless (= (length names) (length (remove-duplicates names eq?))) @@ -550,7 +581,17 @@ [else null])) args arg-contracts - arg-vals))) + arg-vals) + (if result-value + (let ([result-block (if (block? result-value) + result-value + (make-omitable-paragraph (list result-value)))]) + (list (list (list (make-table + "argcontract" + (list (list + (to-flow (make-element #f (list spacer "=" spacer))) + (make-flow (list result-block))))))))) + null))) (define all-args (map prototype-args prototypes)) (define var-list (filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a))) @@ -564,7 +605,7 @@ boxed-style (append-map do-one - stx-ids prototypes all-args arg-contractss arg-valss result-contracts + stx-ids prototypes all-args arg-contractss arg-valss result-contracts result-values (let loop ([ps prototypes] [stx-ids stx-ids] [accum null]) (cond [(null? ps) null] [(ormap (lambda (a) (eq? (extract-id (car ps) (car stx-ids)) a)) accum) @@ -579,21 +620,21 @@ (define-syntax (defparam stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg contract desc ...) + [(_ lt:link-target?-kw id arg contract value:value-kw desc ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) contract] [(id [arg contract]) void?]) + ([(id) contract] [(id [arg contract]) void? #:value value.value]) desc ...)])) (define-syntax (defparam* stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg in-contract out-contract desc ...) + [(_ lt:link-target?-kw id arg in-contract out-contract value:value-kw desc ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) out-contract] [(id [arg in-contract]) void?]) + ([(id) out-contract] [(id [arg in-contract]) void? #:value value.value]) desc ...)])) (define-syntax (defboolparam stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg desc ...) + [(_ lt:link-target?-kw id arg value:value-kw desc ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) boolean?] [(id [arg any/c]) void?]) + ([(id) boolean?] [(id [arg any/c]) void? #:value value.value]) desc ...)])) ;; ---------------------------------------- @@ -962,6 +1003,7 @@ #:defaults ([id-expr #'#f])) id result + value:value-kw desc ...) #'(with-togetherable-racket-variables () @@ -970,11 +1012,12 @@ lt.expr (list (or id-expr (quote-syntax/loc id))) (list 'id) #f (list (racketblock0 result)) - (lambda () (list desc ...))))])) + (lambda () (list desc ...)) + (list (result-value value.value))))])) (define-syntax (defthing* stx) (syntax-parse stx - [(_ kind:kind-kw lt:link-target?-kw ([id result] ...) desc ...) + [(_ kind:kind-kw lt:link-target?-kw ([id result value:value-kw] ...) desc ...) #'(with-togetherable-racket-variables () () @@ -982,7 +1025,8 @@ lt.expr (list (quote-syntax/loc id) ...) (list 'id ...) #f (list (racketblock0 result) ...) - (lambda () (list desc ...))))])) + (lambda () (list desc ...)) + (list (result-value value.value) ...)))])) (define (*defthing kind link? stx-ids names form? result-contracts content-thunk [result-values (map (lambda (x) #f) result-contracts)]) @@ -993,90 +1037,91 @@ (list (make-table boxed-style - (for/list ([stx-id (in-list stx-ids)] - [name (in-list names)] - [result-contract (in-list result-contracts)] - [result-value (in-list result-values)] - [i (in-naturals)]) - (list - ((if (zero? i) (add-background-label (or kind "value")) values) - (make-flow - (make-table-if-necessary - "argcontract" - (let* ([result-block - (and result-value - (if (block? result-value) - result-value - (make-omitable-paragraph (list result-value))))] - [contract-block - (if (block? result-contract) - result-contract - (make-omitable-paragraph (list result-contract)))] - [total-width (+ (string-length (format "~a" name)) - 3 - (block-width contract-block) - (if result-block - (+ (block-width result-block) 3) - 0))]) - (append - (list - (append - (list - (make-flow - (list - (make-omitable-paragraph - (list - (let ([target-maker - (and link? - ((if form? id-to-form-target-maker id-to-target-maker) - stx-id #t))]) - (define-values (content ref-content) - (if link? - (definition-site name stx-id form?) - (let ([s (make-just-context name stx-id)]) - (values (to-element #:defn? #t s) - (to-element s))))) - (if target-maker - (target-maker - content - (lambda (tag) - (make-toc-target2-element - #f - (make-index-element - #f - content - tag - (list (datum-intern-literal (symbol->string name))) - (list ref-content) - (with-exporting-libraries - (lambda (libs) (make-thing-index-desc name libs)))) - tag - ref-content))) - content)))))) - (make-flow - (list - (make-omitable-paragraph - (list - spacer ":" spacer)))) - (make-flow (list contract-block))) - (if (and result-value - (total-width . < . 60)) - (list - (to-flow (make-element #f (list spacer "=" spacer))) - (make-flow (list result-block))) - null))) - (if (and result-value - (total-width . >= . 60)) - (list + (append* + (for/list ([stx-id (in-list stx-ids)] + [name (in-list names)] + [result-contract (in-list result-contracts)] + [result-value (in-list result-values)] + [i (in-naturals)]) + (let* ([result-block + (and result-value + (if (block? result-value) + result-value + (make-omitable-paragraph (list result-value))))] + [contract-block + (if (block? result-contract) + result-contract + (make-omitable-paragraph (list result-contract)))] + [total-width (+ (string-length (format "~a" name)) + 3 + (block-width contract-block) + (if result-block + (+ (block-width result-block) 3) + 0))]) + (append + (list + (list + ((if (zero? i) (add-background-label (or kind "value")) values) + (make-flow + (make-table-if-necessary + "argcontract" + (append + (list + (append (list - (make-table-if-necessary - "argcontract" + (make-flow (list - (list flow-spacer - (to-flow (make-element #f (list spacer "=" spacer))) - (make-flow (list result-block))))) - 'cont)) - null))))))))))) + (make-omitable-paragraph + (list + (let ([target-maker + (and link? + ((if form? id-to-form-target-maker id-to-target-maker) + stx-id #t))]) + (define-values (content ref-content) + (if link? + (definition-site name stx-id form?) + (let ([s (make-just-context name stx-id)]) + (values (to-element #:defn? #t s) + (to-element s))))) + (if target-maker + (target-maker + content + (lambda (tag) + (make-toc-target2-element + #f + (make-index-element + #f + content + tag + (list (datum-intern-literal (symbol->string name))) + (list ref-content) + (with-exporting-libraries + (lambda (libs) (make-thing-index-desc name libs)))) + tag + ref-content))) + content)))))) + (make-flow + (list + (make-omitable-paragraph + (list + spacer ":" spacer)))) + (make-flow (list contract-block))) + (if (and result-value + (and (total-width . < . 60) + (not (table? result-value)))) + (list + (to-flow (make-element #f (list spacer "=" spacer))) + (make-flow (list result-block))) + null))))))))) + (if (and result-value + (or (total-width . >= . 60) + (table? result-value))) + (list (list (list (make-table + "argcontract" + (list (list + (to-flow (make-element #f (list spacer "=" spacer))) + (make-flow (list result-block)))))))) + null)))))))) (content-thunk)))) (define (defthing/proc kind id contract descs) diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt index a11a47d0..2f3a0b28 100644 --- a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt +++ b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt @@ -18,3 +18,5 @@ (define-struct pt (x y)) (struct pn (x y)) + +(define v 10) diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl index 7e6a43be..564d74db 100644 --- a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl +++ b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl @@ -14,6 +14,14 @@ @defproc[#:link-target? #f (f) integer?]{A function, again, not a link target.} +@defproc[#:link-target? #f (f) integer? #:value 10]{A function, again, not a link target, documented to return @racket[10].} + +@defproc[#:link-target? #f (f) integer? #:value (let () + (define x 10) + x)]{ +A function, again, not a link target, documented to return @racket[10] using a definition. +} + @defproc[#:kind "function" #:link-target? #f (g [x void?]) integer?]{A ``function,'' again, not a link target.} @defproc[#:id [i #'j] (i) void?]{Source is @racket[i], documents @racket[j].} @@ -42,12 +50,27 @@ @defparam[#:link-target? #f p k integer?]{A parameter, again.} +@defparam[#:link-target? #f p k integer? #:value 10]{A parameter, again, with a documented default value.} + @defparam*[#:link-target? #f p k real? integer?]{A parameter, yet again.} +@defparam*[#:link-target? #f p k real? integer? #:value 10]{A parameter, yet again, with a documented default value.} + @defboolparam[q on?]{A boolean parameter.} @defboolparam[#:link-target? #f q still-on?]{A boolean parameter, again.} +@defboolparam[#:link-target? #f q still-on? #:value #f]{A boolean parameter, again, with a documented default value.} + + +@defthing[v integer?]{A thing.} + +@defthing[#:link-target? #f v integer?]{A thing, again.} + +@defthing[#:link-target? #f v integer? #:value 10]{A thing, again, with a documented value.} + +@defthing[#:link-target? #f v integer? #:value 12345678901234567890123456789012345678901234567890]{A thing, again, with a documented value that's too wide to fit on one line.} + @defstruct[pt ([x real?] [y real?])]{A structure type with extra name.} diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt index 4444715a..b9b0f3ed 100644 --- a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt +++ b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt @@ -26,6 +26,18 @@ A function with an optional keyword argument. A function, again, not a link target. +(f) -> integer? + = 10 + +A function, again, not a link target, documented to return 10. + +(f) -> integer? + = (define x 10) + x + +A function, again, not a link target, documented to return 10 using a +definition. + (g x) -> integer?   x : void? @@ -86,12 +98,26 @@ A parameter A parameter, again. +(p) -> integer? +(p k) -> void? +  k : integer? + = 10 + +A parameter, again, with a documented default value. + (p) -> integer? (p k) -> void?   k : real? A parameter, yet again. +(p) -> integer? +(p k) -> void? +  k : real? + = 10 + +A parameter, yet again, with a documented default value. + (q) -> boolean? (q on?) -> void?   on? : any/c @@ -104,6 +130,31 @@ A boolean parameter. A boolean parameter, again. +(q) -> boolean? +(q still-on?) -> void? +  still-on? : any/c + = #f + +A boolean parameter, again, with a documented default value. + +v : integer? + +A thing. + +v : integer? + +A thing, again. + +v : integer? = 10 + +A thing, again, with a documented value. + +v : integer? + = 12345678901234567890123456789012345678901234567890 + +A thing, again, with a documented value that’s too wide to fit on one +line. + (struct pt (x y)    #:extra-constructor-name make-pt)   x : real?