suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble/manual: add #:link-target?' to defproc', `defform', etc.

Browse Source 
Specifying `#:link-target? #f' gets blue-box typesetting without
declaring documentaton for a binding.

original commit: 5c4a7db828b1e1d7d43047b6ba32b8a00297df44
This commit is contained in:
Matthew Flatt 2013-04-21 09:34:20 -06:00
parent 8ae2827b2d
commit 8876f00787
7 changed files with 494 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/scribble/private/manual-form.rkt
View File

@ -45,6 +45,12 @@
#:with defined-id #'#f #:with defined-id #'#f
#:with defined-id-expr #'#f)) #:with defined-id-expr #'#f))
(define-splicing-syntax-class link-target?-kw
#:description "#:link-target? keyword"
(pattern (~seq #:link-target? expr))
(pattern (~seq)
#:with expr #'#t))
(define-splicing-syntax-class literals-kw (define-splicing-syntax-class literals-kw
#:description "#:literals keyword" #:description "#:literals keyword"
(pattern (~seq #:literals (lit:id ...))) (pattern (~seq #:literals (lit:id ...)))
@ -70,7 +76,7 @@
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw [spec spec1 ...] [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw [spec spec1 ...]
g:grammar g:grammar
c:contracts-kw c:contracts-kw
desc ...) desc ...)
@ -97,7 +103,7 @@
(l.lit ...) (l.lit ...)
([form [defined-id spec]] [form [defined-id spec1]] ... ([form [defined-id spec]] [form [defined-id spec1]] ...
[non-term (g.non-term-id g.non-term-form ...)] ...) [non-term (g.non-term-id g.non-term-form ...)] ...)
(*defforms k.kind defined-id-expr (*defforms k.kind lt.expr defined-id-expr
'(spec spec1 ...) '(spec spec1 ...)
(list (lambda (x) (racketblock0/form new-spec)) (list (lambda (x) (racketblock0/form new-spec))
(lambda (ignored) (racketblock0/form spec1)) ...) (lambda (ignored) (racketblock0/form spec1)) ...)
@ -113,42 +119,45 @@
(define-syntax (defform* stx) (define-syntax (defform* stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw [spec ...] [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw [spec ...]
subs:subs-kw c:contracts-kw desc ...) subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(defform*/subs #:kind k.kind (defform*/subs #:kind k.kind
#:link-target? lt.expr
#:id [d.defined-id d.defined-id-expr] #:id [d.defined-id d.defined-id-expr]
#:literals (l.lit ...) #:literals (l.lit ...)
[spec ...] subs.g #:contracts c.cs desc ...))])) [spec ...] subs.g #:contracts c.cs desc ...))]))
(define-syntax (defform stx) (define-syntax (defform stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw spec [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw spec
subs:subs-kw c:contracts-kw desc ...) subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(defform*/subs #:kind k.kind (defform*/subs #:kind k.kind
#:link-target? lt.expr
#:id [d.defined-id d.defined-id-expr] #:id [d.defined-id d.defined-id-expr]
#:literals (l.lit ...) #:literals (l.lit ...)
[spec] subs.g #:contracts c.cs desc ...))])) [spec] subs.g #:contracts c.cs desc ...))]))
(define-syntax (defform/subs stx) (define-syntax (defform/subs stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw spec subs desc ...) [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw spec subs desc ...)
(syntax/loc stx (syntax/loc stx
(defform*/subs #:kind k.kind (defform*/subs #:kind k.kind
#:link-target? lt.expr
#:id [d.defined-id d.defined-id-expr] #:id [d.defined-id d.defined-id-expr]
#:literals (l.lit ...) #:literals (l.lit ...)
[spec] subs desc ...))])) [spec] subs desc ...))]))
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw l:literals-kw spec subs:subs-kw c:contracts-kw desc ...) [(_ k:kind-kw lt:link-target?-kw l:literals-kw spec subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(with-togetherable-racket-variables (with-togetherable-racket-variables
(l.lit ...) (l.lit ...)
([form/none spec] ([form/none spec]
[non-term (subs.g.non-term-id subs.g.non-term-form ...)] ...) [non-term (subs.g.non-term-id subs.g.non-term-form ...)] ...)
(*defforms k.kind #f (*defforms k.kind lt.expr #f
'(spec) '(spec)
(list (lambda (ignored) (racketblock0/form spec))) (list (lambda (ignored) (racketblock0/form spec)))
'((subs.g.non-term-id subs.g.non-term-form ...) ...) '((subs.g.non-term-id subs.g.non-term-form ...) ...)
@ -171,11 +180,11 @@
(define-syntax (defidform stx) (define-syntax (defidform stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw spec-id desc ...) [(_ k:kind-kw lt:link-target?-kw spec-id desc ...)
#'(with-togetherable-racket-variables #'(with-togetherable-racket-variables
() ()
() ()
(*defforms k.kind (quote-syntax/loc spec-id) (*defforms k.kind lt.expr (quote-syntax/loc spec-id)
'(spec-id) '(spec-id)
(list (lambda (x) (make-omitable-paragraph (list x)))) (list (lambda (x) (make-omitable-paragraph (list x))))
null null
@ -311,7 +320,7 @@
tag))) tag)))
(car content)))) (car content))))
(define (*defforms kind kw-id forms form-procs subs sub-procs contract-procs content-thunk) (define (*defforms kind link? kw-id forms form-procs subs sub-procs contract-procs content-thunk)
(parameterize ([current-meta-list '(... ...+)]) (parameterize ([current-meta-list '(... ...+)])
(make-box-splice (make-box-splice
(cons (cons
@ -333,7 +342,9 @@
(list (to-element `(,x . ,(cdr form))))))) (list (to-element `(,x . ,(cdr form)))))))
(and kw-id (and kw-id
(eq? form (car forms)) (eq? form (car forms))
(defform-site kw-id))))))) (if link?
(defform-site kw-id)
(to-element kw-id))))))))
(if (null? sub-procs) (if (null? sub-procs)
null null
(list (list flow-empty-line) (list (list flow-empty-line)

277
collects/scribble/private/manual-proc.rkt
View File

@ -123,6 +123,12 @@
(pattern (~optional (~seq #:kind kind) (pattern (~optional (~seq #:kind kind)
#:defaults ([kind #'#f])))) #:defaults ([kind #'#f]))))
(define-splicing-syntax-class link-target?-kw
#:description "#:link-target? keyword"
(pattern (~seq #:link-target? expr))
(pattern (~seq)
#:with expr #'#t))
(define-syntax-class id-or-false (define-syntax-class id-or-false
(pattern i:id) (pattern i:id)
(pattern #f #:with i #'#f)) (pattern #f #:with i #'#f))
@ -146,19 +152,20 @@
(define-syntax (defproc stx) (define-syntax (defproc stx)
(syntax-parse stx (syntax-parse stx
[(_ kind:kind-kw i:id-kw (id arg ...) result desc ...) [(_ kind:kind-kw lt:link-target?-kw i:id-kw (id arg ...) result desc ...)
(syntax/loc stx (syntax/loc stx
(defproc* #:kind kind.kind #: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]] desc ...))]))
(define-syntax (defproc* stx) (define-syntax (defproc* stx)
(syntax-parse stx (syntax-parse stx
[(_ kind:kind-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] ...] desc ...)
(syntax/loc stx (syntax/loc stx
(with-togetherable-racket-variables (with-togetherable-racket-variables
() ()
([proc proto] ...) ([proc proto] ...)
(let ([alt-id d.expr]) (let ([alt-id d.expr])
(*defproc kind.kind (*defproc kind.kind
lt.expr
'mode.m (quote-syntax/loc within.cl) 'mode.m (quote-syntax/loc within.cl)
(list (extract-proc-id d.key alt-id proto) ...) (list (extract-proc-id d.key alt-id proto) ...)
'd.key 'd.key
@ -171,7 +178,7 @@
(define-struct arg (define-struct arg
(special? kw id optional? starts-optional? ends-optional? num-closers)) (special? kw id optional? starts-optional? ends-optional? num-closers))
(define (*defproc kind mode within-id (define (*defproc kind link? mode within-id
stx-ids sym prototypes arg-contractss arg-valss result-contracts stx-ids sym prototypes arg-contractss arg-valss result-contracts
content-thunk) content-thunk)
(define max-proto-width (current-display-width)) (define max-proto-width (current-display-width))
@ -290,7 +297,7 @@
(racket new) (racket new)
(racket make-object)))) (racket make-object))))
(define new-elem (define new-elem
(if first? (if (and first? link?)
(let* ([target-maker (id-to-target-maker within-id #f)]) (let* ([target-maker (id-to-target-maker within-id #f)])
(if target-maker (if target-maker
(target-maker (target-maker
@ -322,7 +329,7 @@
#f #f
(list (racket send) spacer (list (racket send) spacer
(name-this-object (syntax-e within-id)) spacer (name-this-object (syntax-e within-id)) spacer
(if first? (if (and first? link?)
(let* ([mname (extract-id prototype stx-id)] (let* ([mname (extract-id prototype stx-id)]
[target-maker (id-to-target-maker within-id #f)] [target-maker (id-to-target-maker within-id #f)]
[content (list (*method mname within-id))]) [content (list (*method mname within-id))])
@ -347,7 +354,7 @@
tag)))) tag))))
(car content))) (car content)))
(*method (extract-id prototype stx-id) within-id))))] (*method (extract-id prototype stx-id) within-id))))]
[first? [(and first? link?)
(define the-id (extract-id prototype stx-id)) (define the-id (extract-id prototype stx-id))
(let ([target-maker (id-to-target-maker stx-id #t)] (let ([target-maker (id-to-target-maker stx-id #t)]
[content (list (definition-site the-id stx-id #f))]) [content (list (definition-site the-id stx-id #f))])
@ -368,7 +375,7 @@
(car content)))] (car content)))]
[else [else
(define the-id (extract-id prototype stx-id)) (define the-id (extract-id prototype stx-id))
(annote-exporting-library ((if link? annote-exporting-library values)
(let ([sig (current-signature)]) (let ([sig (current-signature)])
(if sig (if sig
(*sig-elem (sig-id sig) the-id) (*sig-elem (sig-id sig) the-id)
@ -567,84 +574,96 @@
(= i 0)))))) (= i 0))))))
(content-thunk)))) (content-thunk))))
(define-syntax-rule (defparam id arg contract desc ...) (define-syntax (defparam stx)
(defproc* #:kind "parameter" ([(id) contract] [(id [arg contract]) void?]) desc ...)) (syntax-parse stx
(define-syntax-rule (defparam* id arg in-contract out-contract desc ...) [(_ lt:link-target?-kw id arg contract desc ...)
(defproc* #:kind "parameter" ([(id) out-contract] [(id [arg in-contract]) void?]) desc ...)) #'(defproc* #:kind "parameter" #:link-target? lt.expr
(define-syntax-rule (defboolparam id arg desc ...) ([(id) contract] [(id [arg contract]) void?])
(defproc* #:kind "parameter" ([(id) boolean?] [(id [arg any/c]) void?]) desc ...)) desc ...)]))
(define-syntax (defparam* stx)
(syntax-parse stx
[(_ lt:link-target?-kw id arg in-contract out-contract desc ...)
#'(defproc* #:kind "parameter" #:link-target? lt.expr
([(id) out-contract] [(id [arg in-contract]) void?])
desc ...)]))
(define-syntax (defboolparam stx)
(syntax-parse stx
[(_ lt:link-target?-kw id arg desc ...)
#'(defproc* #:kind "parameter" #:link-target? lt.expr
([(id) boolean?] [(id [arg any/c]) void?])
desc ...)]))
;; ---------------------------------------- ;; ----------------------------------------
(define-syntax-rule (define-defstruct defstruct default-cname) (begin-for-syntax
(define-splicing-syntax-class mutable-kw
#:description "#:mutable keyword"
(pattern (~seq #:mutable)
#:with immutable? #'#f)
(pattern (~seq)
#:with immutable? #'#t))
(define-splicing-syntax-class opacity-kw
#:description "#:prefab, #:transparent, or #:inspector keyword"
(pattern (~seq #:prefab)
#:with opacity #''prefab)
(pattern (~seq #:transparent)
#:with opacity #''transparent)
(pattern (~seq #:inspector #f)
#:with opacity #''transparent)
(pattern (~seq)
#:with opacity #''opaque))
(define-splicing-syntax-class constructor-kw
#:description "#:constructor-name or #:extra-constructor-name keyword"
(pattern (~seq #:constructor-name id)
#:with given? #'#t
#:with extra? #'#f)
(pattern (~seq #:extra-constructor-name id)
#:with given? #'#t
#:with extra? #'#t)
(pattern (~seq)
#:with id #'#f
#:with given? #'#f
#:with extra? #'#f)))
(define-syntax-rule (define-defstruct defstruct default-extra?)
(... (...
(define-syntax defstruct (define-syntax (defstruct stx)
(syntax-rules () (syntax-parse stx
[(_ name fields #:constructor-name cname #:mutable #:inspector #f desc ...) [(_ lt:link-target?-kw name fields
(**defstruct name fields #f #t #f cname #f desc ...)] m:mutable-kw o:opacity-kw c:constructor-kw
[(_ name fields #:extra-constructor-name cname #:mutable #:inspector #f desc ...) desc ...)
(**defstruct name fields #f #t #f cname #t desc ...)] #'(**defstruct lt.expr name fields
[(_ name fields #:mutable #:inspector #f desc ...) m.immutable? o.opacity
(**defstruct name fields #f #t #f default-cname #t desc ...)] c.id c.given? c.extra? default-extra?
[(_ name fields #:constructor-name cname #:mutable #:transparent desc ...) desc ...)]))))
(**defstruct name fields #f #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f cname #t desc ...)]
[(_ name fields #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t cname #t desc ...)]
[(_ name fields #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:mutable desc ...)
(**defstruct name fields #f #f #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable desc ...)
(**defstruct name fields #f #f #f cname #t desc ...)]
[(_ name fields #:mutable desc ...)
(**defstruct name fields #f #f #f default-cname #f desc ...)]
[(_ name fields #:constructor-name cname #:inspector #f desc ...)
(**defstruct name fields #t #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:inspector #f desc ...)
(**defstruct name fields #t #t #f cname #t desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #t #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:transparent desc ...)
(**defstruct name fields #t #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:transparent desc ...)
(**defstruct name fields #t #t #f cname #t desc ...)]
[(_ name fields #:transparent desc ...)
(**defstruct name fields #t #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:prefab desc ...)
(**defstruct name fields #t #t #t cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:prefab desc ...)
(**defstruct name fields #t #t #t cname #t desc ...)]
[(_ name fields #:prefab desc ...)
(**defstruct name fields #t #t #t default-cname #t desc ...)]
[(_ name fields #:constructor-name cname desc ...)
(**defstruct name fields #t #f #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname desc ...)
(**defstruct name fields #t #f #f cname #t desc ...)]
[(_ name fields desc ...)
(**defstruct name fields #t #f #f default-cname #t desc ...)]))))
(define-defstruct defstruct #t) (define-defstruct defstruct #t)
(define-defstruct defstruct* #f) (define-defstruct defstruct* #f)
(define-syntax-rule (**defstruct name ([field field-contract] ...) immutable? (define-syntax-rule (**defstruct link? name ([field field-contract] ...)
transparent? prefab? cname extra-cname? desc ...) immutable? opacity
cname cname-given? extra-cname? default-extra?
desc ...)
(with-togetherable-racket-variables (with-togetherable-racket-variables
() ()
() ()
(*defstruct (quote-syntax/loc name) 'name (quote-syntax/loc cname) extra-cname? (*defstruct link? (quote-syntax/loc name) 'name
(quote-syntax/loc cname) cname-given? extra-cname? default-extra?
'([field field-contract] ...) '([field field-contract] ...)
(list (lambda () (racketblock0 field-contract)) ...) (list (lambda () (racketblock0 field-contract)) ...)
immutable? transparent? prefab? (lambda () (list desc ...))))) immutable? opacity
(lambda () (list desc ...)))))
(define (*defstruct stx-id name alt-cname-id extra-cname? (define (*defstruct link? stx-id name
fields field-contracts immutable? transparent? prefab? alt-cname-id cname-given? extra-cname? default-extra?
fields field-contracts
immutable? opacity
content-thunk) content-thunk)
(define transparent? (or (eq? opacity 'transparent)
(eq? opacity 'prefab)))
(define prefab? (eq? opacity 'prefab))
(define max-proto-width (current-display-width)) (define max-proto-width (current-display-width))
(define (field-name f) ((if (pair? (car f)) caar car) f)) (define (field-name f) ((if (pair? (car f)) caar car) f))
(define (field-view f) (define (field-view f)
@ -652,7 +671,7 @@
(define cname-id (define cname-id
(cond (cond
[(identifier? alt-cname-id) alt-cname-id] [(identifier? alt-cname-id) alt-cname-id]
[(not (syntax-e alt-cname-id)) #f] [(not default-extra?) #f]
[else (let ([name-id (if (identifier? stx-id) [else (let ([name-id (if (identifier? stx-id)
stx-id stx-id
(car (syntax-e stx-id)))]) (car (syntax-e stx-id)))])
@ -670,39 +689,45 @@
(list (list
(let* ([the-name (let* ([the-name
(let ([just-name (let ([just-name
(make-target-element* (if link?
make-toc-target-element (make-target-element*
(if (pair? name) make-toc-target-element
(car (syntax-e stx-id)) (if (pair? name)
stx-id) (car (syntax-e stx-id))
(annote-exporting-library stx-id)
(to-element (annote-exporting-library
(if (pair? name) (to-element
(make-just-context (car name) (if (pair? name)
(car (syntax-e stx-id))) (make-just-context (car name)
stx-id))) (car (syntax-e stx-id)))
(let ([name (if (pair? name) (car name) name)]) stx-id)))
(list* (list 'info name) (let ([name (if (pair? name) (car name) name)])
(list 'type 'struct: name) (list* (list 'info name)
(list 'predicate name '?) (list 'type 'struct: name)
(append (list 'predicate name '?)
(if cname-id (append
(list (list 'constructor (syntax-e cname-id))) (if cname-id
null) (list (list 'constructor (syntax-e cname-id)))
(map (lambda (f) null)
(list 'accessor name '- (map (lambda (f)
(field-name f))) (list 'accessor name '-
fields) (field-name f)))
(filter-map fields)
(lambda (f) (filter-map
(if (or (not immutable?) (lambda (f)
(and (pair? (car f)) (if (or (not immutable?)
(memq '#:mutable (and (pair? (car f))
(car f)))) (memq '#:mutable
(list 'mutator 'set- name '- (car f))))
(field-name f) '!) (list 'mutator 'set- name '-
#f)) (field-name f) '!)
fields)))))]) #f))
fields)))))
(to-element
(if (pair? name)
(make-just-context (car name)
(car (syntax-e stx-id)))
stx-id)))])
(if (pair? name) (if (pair? name)
(make-element (make-element
#f #f
@ -834,7 +859,9 @@
e))))) e)))))
(loop (cdr fields)))))) (loop (cdr fields))))))
(if cname-id (if cname-id
(let ([kw (to-element (if extra-cname? (let ([kw (to-element (if (if cname-given?
extra-cname?
default-extra?)
'#:extra-constructor-name '#:extra-constructor-name
'#:constructor-name))] '#:constructor-name))]
[nm (to-element cname-id)] [nm (to-element cname-id)]
@ -916,6 +943,7 @@
(define-syntax (defthing stx) (define-syntax (defthing stx)
(syntax-parse stx (syntax-parse stx
[(_ kind:kind-kw [(_ kind:kind-kw
lt:link-target?-kw
(~optional (~seq #:id id-expr) (~optional (~seq #:id id-expr)
#:defaults ([id-expr #'#f])) #:defaults ([id-expr #'#f]))
id id
@ -925,24 +953,24 @@
() ()
() ()
(*defthing kind.kind (*defthing kind.kind
lt.expr
(list (or id-expr (quote-syntax/loc id))) (list 'id) #f (list (or id-expr (quote-syntax/loc id))) (list 'id) #f
(list (racketblock0 result)) (list (racketblock0 result))
(lambda () (list desc ...))))])) (lambda () (list desc ...))))]))
(define-syntax defthing* (define-syntax (defthing* stx)
(syntax-rules () (syntax-parse stx
[(_ #:kind kind ([id result] ...) desc ...) [(_ kind:kind-kw lt:link-target?-kw ([id result] ...) desc ...)
(with-togetherable-racket-variables #'(with-togetherable-racket-variables
() ()
() ()
(*defthing kind (*defthing kind.kind
(list (quote-syntax/loc id) ...) (list 'id ...) #f lt.expr
(list (racketblock0 result) ...) (list (quote-syntax/loc id) ...) (list 'id ...) #f
(lambda () (list desc ...))))] (list (racketblock0 result) ...)
[(_ ([id result] ...) desc ...) (lambda () (list desc ...))))]))
(defthing* #:kind #f ([id result] ...) desc ...)]))
(define (*defthing kind stx-ids names form? result-contracts content-thunk (define (*defthing kind link? stx-ids names form? result-contracts content-thunk
[result-values (map (lambda (x) #f) result-contracts)]) [result-values (map (lambda (x) #f) result-contracts)])
(make-box-splice (make-box-splice
(cons (cons
@ -985,9 +1013,12 @@
(make-omitable-paragraph (make-omitable-paragraph
(list (list
(let ([target-maker (let ([target-maker
((if form? id-to-form-target-maker id-to-target-maker) (and link?
stx-id #t)] ((if form? id-to-form-target-maker id-to-target-maker)
[content (list (definition-site name stx-id form?))]) stx-id #t))]
[content (list (if link?
(definition-site name stx-id form?)
(to-element (make-just-context name stx-id))))])
(if target-maker (if target-maker
(target-maker (target-maker
content content
@ -1032,7 +1063,7 @@
(content-thunk)))) (content-thunk))))
(define (defthing/proc kind id contract descs) (define (defthing/proc kind id contract descs)
(*defthing kind (list id) (list (syntax-e id)) #f (list contract) (*defthing kind #t (list id) (list (syntax-e id)) #f (list contract)
(lambda () descs))) (lambda () descs)))
(define (make-target-element* inner-make-target-element stx-id content wrappers) (define (make-target-element* inner-make-target-element stx-id content wrappers)

1
collects/scribble/private/manual-unit.rkt
View File

@ -41,6 +41,7 @@
(define (*defsignature stx-id supers body-thunk indent?) (define (*defsignature stx-id supers body-thunk indent?)
(*defthing (*defthing
"signature" "signature"
#t
(list stx-id) (list stx-id)
(list (syntax-e stx-id)) (list (syntax-e stx-id))
#t #t

92
collects/scribblings/scribble/manual.scrbl
View File

@ -674,7 +674,7 @@ sub-sections.}
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------
@section[#:tag "doc-forms"]{Documenting Forms, Functions, Structure Types, and Values} @section[#:tag "doc-forms"]{Documenting Forms, Functions, Structure Types, and Values}
@defform/subs[(defproc maybe-kind maybe-id prototype @defform/subs[(defproc options prototype
result-contract-expr-datum result-contract-expr-datum
pre-flow ...) pre-flow ...)
([prototype (id arg-spec ...) ([prototype (id arg-spec ...)
@ -685,8 +685,11 @@ sub-sections.}
(keyword arg-id contract-expr-datum default-expr) (keyword arg-id contract-expr-datum default-expr)
ellipses ellipses
ellipses+] ellipses+]
[options (code:line maybe-kind maybe-link maybe-id)]
[maybe-kind code:blank [maybe-kind code:blank
(code:line #:kind kind-string-expr)] (code:line #:kind kind-string-expr)]
[maybe-link code:blank
(code:line #:link-target? link-target?-expr)]
[maybe-id code:blank [maybe-id code:blank
(code:line #:id [src-id dest-id-expr])] (code:line #:id [src-id dest-id-expr])]
[ellipses @#,lit-ellipses] [ellipses @#,lit-ellipses]
@ -695,11 +698,13 @@ sub-sections.}
Produces a sequence of flow elements (encapsulated in a Produces a sequence of flow elements (encapsulated in a
@racket[splice]) to document a procedure named @racket[id]. Nesting @racket[splice]) to document a procedure named @racket[id]. Nesting
@racket[prototype]s corresponds to a curried function, as in @racket[prototype]s corresponds to a curried function, as in
@racket[define]. The @racket[id] is indexed, and it also registered so @racket[define]. Unless @racket[link-target?-expr] is specified
and produces @racket[#f], the @racket[id] is indexed, and it also registered so
that @racket[racket]-typeset uses of the identifier (with the same that @racket[racket]-typeset uses of the identifier (with the same
for-label binding) are hyperlinked to this documentation. for-label binding) are hyperlinked to this documentation.
A @racket[defmodule] or @racket[declare-exporting] form (or one of the When @racket[id] is indexed and registered,
a @racket[defmodule] or @racket[declare-exporting] form (or one of the
variants) in an enclosing section determines the @racket[id] binding variants) in an enclosing section determines the @racket[id] binding
that is being defined. The @racket[id] should also have a for-label that is being defined. The @racket[id] should also have a for-label
binding (as introduced by @racket[(require (for-label ....))]) that binding (as introduced by @racket[(require (for-label ....))]) that
@ -783,19 +788,21 @@ Examples:
}| }|
} }
@defform[(defproc* maybe-kind maybe-id @defform[(defproc* options
([prototype ([prototype
result-contract-expr-datum] ...) result-contract-expr-datum] ...)
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defproc], but for multiple cases with the same Like @racket[defproc], but for multiple cases with the same
@racket[id]. @racket[id]. Multiple distinct @racket[id]s can also be defined by a
single @racket[defproc*], for the case that it's best to document a
related group of procedures at once (but multiple @racket[defproc]s
grouped by @racket[deftogether] also works for that case).
When an @racket[id] has multiple calling cases, they must be defined When an @racket[id] has multiple calling cases, either they must be
with a single @racket[defproc*], so that a single definition point defined with a single @racket[defproc*], so that a single definition
exists for the @racket[id]. However, multiple distinct @racket[id]s point exists for the @racket[id], or else all but one definition
can also be defined by a single @racket[defproc*], for the case that should use @racket[#:link-target? #f].
it's best to document a related group of procedures at once.
Examples: Examples:
@codeblock[#:keep-lang-line? #f]|{ @codeblock[#:keep-lang-line? #f]|{
@ -811,11 +818,14 @@ Examples:
} }
@defform/subs[(defform maybe-kind maybe-id maybe-literals form-datum @defform/subs[(defform options form-datum
maybe-grammar maybe-contracts maybe-grammar maybe-contracts
pre-flow ...) pre-flow ...)
([maybe-kind code:blank ([options (code:line maybe-kind maybe-link maybe-id maybe-literals)]
[maybe-kind code:blank
(code:line #:kind kind-string-expr)] (code:line #:kind kind-string-expr)]
[maybe-link code:blank
(code:line #:link-target? link-target?-expr)]
[maybe-id code:blank [maybe-id code:blank
(code:line #:id id) (code:line #:id id)
(code:line #:id [id id-expr])] (code:line #:id [id id-expr])]
@ -844,7 +854,9 @@ a defining instance), and @racket[id-expr] produces the identifier to
be documented. This split between @racket[id] and @racket[id-expr] be documented. This split between @racket[id] and @racket[id-expr]
roles is useful for functional abstraction of @racket[defform]. roles is useful for functional abstraction of @racket[defform].
The @racket[id] (or result of @racket[id-expr]) is indexed, and it is Unless @racket[link-target?-expr] is specified
and produces @racket[#f],
the @racket[id] (or result of @racket[id-expr]) is indexed, and it is
also registered so that @racket[racket]-typeset uses of the identifier also registered so that @racket[racket]-typeset uses of the identifier
(with the same for-label binding) are hyperlinked to this (with the same for-label binding) are hyperlinked to this
documentation. The @racket[defmodule] or @racket[declare-exporting] documentation. The @racket[defmodule] or @racket[declare-exporting]
@ -910,7 +922,7 @@ Examples:
}| }|
} }
@defform[(defform* maybe-kind maybe-id maybe-literals [form-datum ...+] @defform[(defform* options [form-datum ...+]
maybe-grammar maybe-contracts maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
@ -934,10 +946,10 @@ Examples:
maybe-grammar maybe-contracts maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defform], but without registering a definition.} Like @racket[defform] with @racket[#:link-target? #f].}
@defform[(defidform maybe-kind id pre-flow ...)]{ @defform[(defidform maybe-kind maybe-link id pre-flow ...)]{
Like @racket[defform], but with a plain @racket[id] as the form.} Like @racket[defform], but with a plain @racket[id] as the form.}
@ -954,16 +966,17 @@ not stand out to the reader as a specification of @racket[id].}
@defform[(specform maybe-literals datum maybe-grammar maybe-contracts @defform[(specform maybe-literals datum maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defform], but without indexing or registering a Like @racket[defform] with @racket[#:link-target? #f], but with
definition, and with indenting on the left for both the specification indenting on the left for both the specification and the
and the @racket[pre-flow]s.} @racket[pre-flow]s.}
@defform[(specsubform maybe-literals datum maybe-grammar maybe-contracts @defform[(specsubform maybe-literals datum maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Similar to @racket[defform], but without any specific identifier being Similar to @racket[defform] with @racket[#:link-target? #f],
defined, and the table and flow are typeset indented. This form is but without the initial identifier as an implicit literal,
and the table and flow are typeset indented. This form is
intended for use when refining the syntax of a non-terminal used in a intended for use when refining the syntax of a non-terminal used in a
@racket[defform] or other @racket[specsubform]. For example, it is @racket[defform] or other @racket[specsubform]. For example, it is
used in the documentation for @racket[defproc] in the itemization of used in the documentation for @racket[defproc] in the itemization of
@ -984,11 +997,11 @@ without nesting a description.}
@deftogether[[ @deftogether[[
@defform[(defform/subs maybe-kind maybe-id maybe-literals form-datum @defform[(defform/subs options form-datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts maybe-contracts
pre-flow ...)] pre-flow ...)]
@defform[(defform*/subs maybe-kind maybe-id maybe-literals [form-datum ...+] @defform[(defform*/subs options [form-datum ...+]
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts maybe-contracts
pre-flow ...)] pre-flow ...)]
@ -1026,7 +1039,7 @@ Examples:
} }
@defform[(defparam id arg-id contract-expr-datum pre-flow ...)]{ @defform[(defparam maybe-link id arg-id contract-expr-datum pre-flow ...)]{
Like @racket[defproc], but for a parameter. The Like @racket[defproc], but for a parameter. The
@racket[contract-expr-datum] serves as both the result contract on the @racket[contract-expr-datum] serves as both the result contract on the
@ -1043,17 +1056,31 @@ Examples:
}| }|
} }
@defform[(defboolparam id arg-id pre-flow ...)]{
@defform[(defparam* maybe-link id arg-id
in-contract-expr-datum out-contract-expr-datum
pre-flow ...)]{
Like @racket[defparam], but with separate contracts for when the parameter is being
set versus when it is being retrieved (for the case that a parameter guard
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 ...)]{
Like @racket[defparam], but the contract on a parameter argument is Like @racket[defparam], but the contract on a parameter argument is
@racket[any/c], and the contract on the parameter result is @racket[any/c], and the contract on the parameter result is
@racket[boolean?].} @racket[boolean?].}
@defform/subs[(defthing maybe-kind maybe-id id contract-expr-datum @defform/subs[(defthing options id contract-expr-datum
pre-flow ...) pre-flow ...)
([maybe-kind code:blank ([options (code:line maybe-kind maybe-link maybe-id)]
[maybe-kind code:blank
(code:line #:kind kind-string-expr)] (code:line #:kind kind-string-expr)]
[maybe-link code:blank
(code:line #:link-target? link-target?-expr)]
[maybe-id code:blank [maybe-id code:blank
(code:line #:id id-expr)])]{ (code:line #:id id-expr)])]{
@ -1077,19 +1104,22 @@ Examples:
@deftogether[( @deftogether[(
@defform[ (defstruct* struct-name ([field-name contract-expr-datum] ...) @defform[ (defstruct* maybe-link struct-name ([field-name contract-expr-datum] ...)
maybe-mutable maybe-non-opaque maybe-constructor maybe-mutable maybe-non-opaque maybe-constructor
pre-flow ...)] pre-flow ...)]
@defform/subs[ (defstruct struct-name ([field-name contract-expr-datum] ...) @defform/subs[ (defstruct maybe-link struct-name ([field-name contract-expr-datum] ...)
maybe-mutable maybe-non-opaque maybe-constructor maybe-mutable maybe-non-opaque maybe-constructor
pre-flow ...) pre-flow ...)
([struct-name id ([maybe-link code:blank
(code:line #:link-target? link-target?-expr)]
[struct-name id
(id super-id)] (id super-id)]
[maybe-mutable code:blank [maybe-mutable code:blank
#:mutable] #:mutable]
[maybe-non-opaque code:blank [maybe-non-opaque code:blank
#:prefab #:prefab
#:transparent] #:transparent
(code:line #:inspector #f)]
[maybe-constructor code:blank [maybe-constructor code:blank
(code:line #:constructor-name constructor-id) (code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)])] (code:line #:extra-constructor-name constructor-id)])]

20
collects/tests/scribble/docs/manual-ex.rkt Normal file
View File

@ -0,0 +1,20 @@
#lang racket/base
(require (for-syntax racket/base))
(provide (all-defined-out))
(define (f) 10)
(define (g x y) (void))
(define (h x #:y y) (void))
(define (i x #:y [y #f]) (void))
(define (j) (void))
(define-syntax-rule (m x) 'x)
(define-syntax n (lambda (stx) #`(quote #,stx)))
(define p (make-parameter 10))
(define q (make-parameter #f))
(define-struct pt (x y))
(struct pn (x y))

68
collects/tests/scribble/docs/manual.scrbl Normal file
View File

@ -0,0 +1,68 @@
#lang scribble/manual
@(require (for-label racket/base
"manual-ex.rkt"))
@defmodule["manual-ex.rkt"]
@defproc[(f) integer?]{A function.}
@defproc[(g [x void?] [y void?]) integer?]{A function with two arguments.}
@defproc[#:kind "function" (h [x void?] [#:y y void?]) integer?]{A ``function'' with a keyword argument.}
@defproc[(i [x void?] [#:y y void? (void)]) integer?]{A function with an optional keyword argument.}
@defproc[#:link-target? #f (f) integer?]{A function, again, not a link target.}
@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].}
@defproc*[#:link-target? #f ([(f) integer?] [(g [x void?] [y void?]) void?])]{Functions, yet again.}
@defform[(m datum)]{A syntactic form.}
@defform[#:link-target? #f (m datum)]{A syntactic form, again.}
@defform[#:kind "macro" #:link-target? #f (m datum)]{A ``macro,'' again.}
@defform*[#:kind "macro" #:link-target? #f [(m datum) (m same-datum)]]{A ``macro,'' yet again.}
@defform/none[(m datum)]{Yet again.}
@defidform[n]{An identifier form.}
@defidform[#:link-target? #f n]{An identifier form, again.}
@specform[(m datum)]{Specification of @racket[m].}
@defparam[p k integer?]{A parameter}
@defparam[#:link-target? #f p k integer?]{A parameter, again.}
@defparam*[#:link-target? #f p k real? integer?]{A parameter, yet again.}
@defboolparam[q on?]{A boolean parameter.}
@defboolparam[#:link-target? #f q still-on?]{A boolean parameter, again.}
@defstruct[pt ([x real?] [y real?])]{A structure type with extra name.}
@defstruct*[pn ([x real?] [y real?])]{A structure type.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?])]{A structure type, again.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?]) #:transparent]{A transparent structure type, again.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?]) #:inspector #f]{A transparent structure type, again.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?]) #:prefab]{A prefab structure type, again.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?]) #:constructor-name pt]{A structure type with name, again.}
@defstruct*[#:link-target? #f pn ([x real?] [y real?]) #:extra-constructor-name pt]{A structure type with extra name, again.}
@defstruct[#:link-target? #f pt ([x real?] [y real?]) #:mutable]{A mutable structure type with extra name, again.}

167
collects/tests/scribble/docs/manual.txt Normal file
View File

@ -0,0 +1,167 @@
 (require "manual-ex.rkt")
(f) -> integer?
A function.
(g x y) -> integer?
  x : void?
  y : void?
A function with two arguments.
(h x #:y y) -> integer?
  x : void?
  y : void?
A “function” with a keyword argument.
(i x [#:y y]) -> integer?
  x : void?
  y : void? = (void)
A function with an optional keyword argument.
(f) -> integer?
A function, again, not a link target.
(g x) -> integer?
  x : void?
A “function,” again, not a link target.
(j) -> void?
Source is i, documents j.
(f) -> integer?
(g x y) -> void?
  x : void?
  y : void?
Functions, yet again.
(m datum)
A syntactic form.
(m datum)
A syntactic form, again.
(m datum)
A “macro,” again.
(m datum)
(m same-datum)
A “macro,” yet again.
(m datum)
Yet again.
n
An identifier form.
n
An identifier form, again.
(m datum)
Specification of m.
(p) -> integer?
(p k) -> void?
  k : integer?
A parameter
(p) -> integer?
(p k) -> void?
  k : integer?
A parameter, again.
(p) -> integer?
(p k) -> void?
  k : real?
A parameter, yet again.
(q) -> boolean?
(q on?) -> void?
  on? : any/c
A boolean parameter.
(q) -> boolean?
(q still-on?) -> void?
  still-on? : any/c
A boolean parameter, again.
(struct pt (x y)
   #:extra-constructor-name make-pt)
  x : real?
  y : real?
A structure type with extra name.
(struct pn (x y))
  x : real?
  y : real?
A structure type.
(struct pn (x y))
  x : real?
  y : real?
A structure type, again.
(struct pn (x y)
   #:transparent)
  x : real?
  y : real?
A transparent structure type, again.
(struct pn (x y)
   #:transparent)
  x : real?
  y : real?
A transparent structure type, again.
(struct pn (x y)
   #:prefab)
  x : real?
  y : real?
A prefab structure type, again.
(struct pn (x y)
   #:constructor-name pt)
  x : real?
  y : real?
A structure type with name, again.
(struct pn (x y)
   #:extra-constructor-name pt)
  x : real?
  y : real?
A structure type with extra name, again.
(struct pt (x y)
   #:extra-constructor-name make-pt
   #:mutable)
  x : real?
  y : real?
A mutable structure type with extra name, again.