diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt
index 0dc3dad9..a8f099e6 100644
--- a/collects/scribble/html-render.rkt
+++ b/collects/scribble/html-render.rkt
@@ -141,8 +141,13 @@
(style-properties style)))])
(let ([name (style-name style)])
(if (string? name)
- (cons `[class ,name]
- a)
+ (if (assq 'class a)
+ (for/list ([i (in-list a)])
+ (if (eq? (car i) 'class)
+ (list 'class (string-append name " " (cadr i)))
+ i))
+ (cons `[class ,name]
+ a))
a))))
;; combine a 'class attribute from both cl and al
@@ -681,7 +686,8 @@
css-addition-path)
(list style-file)
style-extra-files))
- ,(scribble-js-contents script-file (lookup-path script-file alt-paths)))
+ ,(scribble-js-contents script-file (lookup-path script-file alt-paths))
+ ,(xml:comment "[if IE 6]>attribs (nested-flow-style t)))]
- ,@(apply append
- (super render-nested-flow t part ri starting-item?)))))
+ `((,(or (style->tag (nested-flow-style t)) 'blockquote)
+ [,@(combine-class
+ (cond
+ [(eq? 'code-inset (style-name (nested-flow-style t)))
+ `([class "SCodeFlow"])]
+ [(eq? 'vertical-inset (style-name (nested-flow-style t)))
+ `([class "SVInsetFlow"])]
+ [(and (not (string? (style-name (nested-flow-style t))))
+ (not (eq? 'inset (style-name (nested-flow-style t)))))
+ `([class "SubFlow"])]
+ [else null])
+ (style->attribs (nested-flow-style t)))]
+ ,@(apply append
+ (super render-nested-flow t part ri starting-item?)))))
(define/override (render-compound-paragraph t part ri starting-item?)
(let ([style (compound-paragraph-style t)])
diff --git a/collects/scribble/private/manual-class.rkt b/collects/scribble/private/manual-class.rkt
index 8f97596e..b2edd921 100644
--- a/collects/scribble/private/manual-class.rkt
+++ b/collects/scribble/private/manual-class.rkt
@@ -14,6 +14,7 @@
"manual-bind.rkt"
"manual-method.rkt"
"manual-proc.rkt"
+ "manual-vars.rkt"
scheme/list
(for-syntax scheme/base)
(for-label scheme/base
@@ -187,39 +188,41 @@
(define (*class-doc kind stx-id super intfs ranges whole-page? make-index-desc)
(make-table
- 'boxed
+ boxed-style
(append
(list
- (list (make-flow
- (list
- (make-omitable-paragraph
- (list (let ([target-maker (id-to-target-maker stx-id #t)]
- [content (list (annote-exporting-library
- (to-element stx-id)))])
- (if target-maker
- (target-maker
- content
- (lambda (tag)
- ((if whole-page?
+ (list
+ ((add-background-label (symbol->string kind))
+ (make-flow
+ (list
+ (make-omitable-paragraph
+ (list (let ([target-maker (id-to-target-maker stx-id #t)]
+ [content (list (annote-exporting-library
+ (to-element stx-id)))])
+ (if target-maker
+ (target-maker
+ content
+ (lambda (tag)
+ ((if whole-page?
make-page-target-element
make-toc-target-element)
- #f
- (list
- (make-index-element
- #f content tag
- (list (datum-intern-literal
- (symbol->string (syntax-e stx-id))))
- content
- (with-exporting-libraries
- (lambda (libs)
- (make-index-desc (syntax-e stx-id) libs)))))
- tag)))
- (car content)))
- spacer ":" spacer
- (case kind
- [(class) (racket class?)]
- [(interface) (racket interface?)]
- [(mixin) (racketblockelem (class? . -> . class?))])))))))
+ #f
+ (list
+ (make-index-element
+ #f content tag
+ (list (datum-intern-literal
+ (symbol->string (syntax-e stx-id))))
+ content
+ (with-exporting-libraries
+ (lambda (libs)
+ (make-index-desc (syntax-e stx-id) libs)))))
+ tag)))
+ (car content)))
+ spacer ":" spacer
+ (case kind
+ [(class) (racket class?)]
+ [(interface) (racket interface?)]
+ [(mixin) (racketblockelem (class? . -> . class?))]))))))))
(if super
(list
(list (make-flow
diff --git a/collects/scribble/private/manual-form.rkt b/collects/scribble/private/manual-form.rkt
index 20f40bac..e793daed 100644
--- a/collects/scribble/private/manual-form.rkt
+++ b/collects/scribble/private/manual-form.rkt
@@ -26,7 +26,7 @@
(define-syntax (defform*/subs stx)
(syntax-case stx ()
- [(_ #:id defined-id #:literals (lit ...) [spec spec1 ...]
+ [(_ #:kind kind #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...)
desc ...)
@@ -57,7 +57,7 @@
(lit ...)
([form [defined-id spec]] [form [defined-id spec1]] ...
[non-term (non-term-id non-term-form ...)] ...)
- (*defforms defined-id-expr
+ (*defforms kind defined-id-expr
'(spec spec1 ...)
(list (lambda (x) (racketblock0/form new-spec))
(lambda (ignored) (racketblock0/form spec1)) ...)
@@ -70,6 +70,15 @@
(lambda () (racketblock0 contract-expr)))
...)
(lambda () (list desc ...))))))]
+ [(fm #:id defined-id #:literals (lit ...) [spec spec1 ...]
+ ([non-term-id non-term-form ...] ...)
+ #:contracts ([contract-nonterm contract-expr] ...)
+ desc ...)
+ (syntax/loc stx
+ (fm #:kind #f #:id defined-id #:literals (lit ...) [spec spec1 ...]
+ ([non-term-id non-term-form ...] ...)
+ #:contracts ([contract-nonterm contract-expr] ...)
+ desc ...))]
[(fm #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...)
@@ -78,74 +87,130 @@
([non-term-id non-term-form ...] ...)
#:contracts ()
desc ...))]
- [(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
+ [(fm #:kind kind #:id defined-id #:literals (lit ...) [spec spec1 ...]
+ ([non-term-id non-term-form ...] ...)
desc ...)
(syntax/loc stx
- (fm #:id id #:literals () [spec spec1 ...]
+ (fm #:kind kind #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
#:contracts ()
desc ...))]
+ [(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
+ desc ...)
+ (syntax/loc stx
+ (fm #:kind #f #:id id #:literals () [spec spec1 ...]
+ ([non-term-id non-term-form ...] ...)
+ #:contracts ()
+ desc ...))]
+ [(fm #:kind kind #:literals lits [(spec-id . spec-rest) spec1 ...]
+ ([non-term-id non-term-form ...] ...)
+ desc ...)
+ (with-syntax ([(_ _ _ _ _ [spec . _] . _) stx])
+ (syntax/loc stx
+ (fm #:kind kind #:id spec-id #:literals lits [spec spec1 ...]
+ ([non-term-id non-term-form ...] ...)
+ desc ...)))]
[(fm #:literals lits [(spec-id . spec-rest) spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...)
(with-syntax ([(_ _ _ [spec . _] . _) stx])
(syntax/loc stx
- (fm #:id spec-id #:literals lits [spec spec1 ...]
+ (fm #:kind #f #:id spec-id #:literals lits [spec spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...)))]
+ [(fm #:kind kind [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
+ (syntax/loc stx
+ (fm #:kind kind #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...)
+ desc ...))]
[(fm [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(syntax/loc stx
- (fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...)
+ (fm #:kind #f #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...)
desc ...))]))
(define-syntax (defform* stx)
(syntax-case stx ()
+ [(_ #:kind kind #:id id #:literals lits [spec ...] desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id #:literals lits [spec ...] () desc ...))]
[(_ #:id id #:literals lits [spec ...] desc ...)
(syntax/loc stx
(defform*/subs #:id id #:literals lits [spec ...] () desc ...))]
+ [(_ #:kind kind #:literals lits [spec ...] desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:literals lits [spec ...] () desc ...))]
[(_ #:literals lits [spec ...] desc ...)
(syntax/loc stx
(defform*/subs #:literals lits [spec ...] () desc ...))]
+ [(_ #:kind kind #:id id [spec ...] desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id [spec ...] () desc ...))]
[(_ #:id id [spec ...] desc ...)
(syntax/loc stx
(defform*/subs #:id id [spec ...] () desc ...))]
+ [(_ #:kind kind [spec ...] desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind [spec ...] () desc ...))]
[(_ [spec ...] desc ...)
(syntax/loc stx
(defform*/subs [spec ...] () desc ...))]))
(define-syntax (defform stx)
(syntax-case stx ()
+ [(_ #:kind kind #:id id #:literals (lit ...) spec desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id #:literals (lit ...) [spec] () desc ...))]
[(_ #:id id #:literals (lit ...) spec desc ...)
(syntax/loc stx
(defform*/subs #:id id #:literals (lit ...) [spec] () desc ...))]
+ [(_ #:kind kind #:id id spec desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id #:literals () [spec] () desc ...))]
[(_ #:id id spec desc ...)
(syntax/loc stx
(defform*/subs #:id id #:literals () [spec] () desc ...))]
[(_ #:literals (lit ...) spec desc ...)
(syntax/loc stx
(defform*/subs #:literals (lit ...) [spec] () desc ...))]
+ [(_ #:kind kind #:literals (lit ...) spec desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:literals (lit ...) [spec] () desc ...))]
+ [(_ #:kind kind spec desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind [spec] () desc ...))]
[(_ spec desc ...)
(syntax/loc stx
(defform*/subs [spec] () desc ...))]))
(define-syntax (defform/subs stx)
(syntax-case stx ()
+ [(_ #:kind kind #:id id #:literals lits spec subs desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id #:literals lits [spec] subs desc ...))]
[(_ #:id id #:literals lits spec subs desc ...)
(syntax/loc stx
(defform*/subs #:id id #:literals lits [spec] subs desc ...))]
+ [(_ #:kind kind #:id id spec subs desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:id id #:literals () [spec] subs desc ...))]
[(_ #:id id spec subs desc ...)
(syntax/loc stx
(defform*/subs #:id id #:literals () [spec] subs desc ...))]
+ [(_ #:kind kind #:literals lits spec subs desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind #:literals lits [spec] subs desc ...))]
[(_ #:literals lits spec subs desc ...)
(syntax/loc stx
(defform*/subs #:literals lits [spec] subs desc ...))]
+ [(_ #:kind kind spec subs desc ...)
+ (syntax/loc stx
+ (defform*/subs #:kind kind [spec] subs desc ...))]
[(_ spec subs desc ...)
(syntax/loc stx
(defform*/subs [spec] subs desc ...))]))
(define-syntax (defform/none stx)
(syntax-case stx ()
- [(_ #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...)
+ [(_ #:kind kind #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...)
(begin
(for-each (lambda (id)
(unless (identifier? id)
@@ -157,16 +222,25 @@
#'(with-togetherable-racket-variables
(lit ...)
([form/none spec])
- (*defforms #f
+ (*defforms kind #f
'(spec) (list (lambda (ignored) (racketblock0/form spec)))
null null
(list (list (lambda () (racket contract-id))
(lambda () (racketblock0 contract-expr)))
...)
(lambda () (list desc ...)))))]
+ [(fm #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...)
+ (syntax/loc stx
+ (fm #:kind #f #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...))]
+ [(fm #:kind kind #:literals (lit ...) spec desc ...)
+ (syntax/loc stx
+ (fm #:kind kind #:literals (lit ...) spec #:contracts () desc ...))]
[(fm #:literals (lit ...) spec desc ...)
(syntax/loc stx
(fm #:literals (lit ...) spec #:contracts () desc ...))]
+ [(fm #:kind kind spec desc ...)
+ (syntax/loc stx
+ (fm #:kind kind #:literals () spec desc ...))]
[(fm spec desc ...)
(syntax/loc stx
(fm #:literals () spec desc ...))]))
@@ -181,17 +255,20 @@
(define-syntax (defidform stx)
(syntax-case stx ()
- [(_ spec-id desc ...)
+ [(_ #:kind kind spec-id desc ...)
#'(with-togetherable-racket-variables
()
()
- (*defforms (quote-syntax/loc spec-id)
+ (*defforms kind (quote-syntax/loc spec-id)
'(spec-id)
(list (lambda (x) (make-omitable-paragraph (list x))))
null
null
null
- (lambda () (list desc ...))))]))
+ (lambda () (list desc ...))))]
+ [(fm spec-id desc ...)
+ (syntax/loc stx
+ (fm #:kind #f spec-id desc ...))]))
(define (into-blockquote s)
(make-blockquote "leftindent"
@@ -336,7 +413,7 @@
tag)))
(car content))))
-(define (*defforms kw-id forms form-procs subs sub-procs contract-procs content-thunk)
+(define (*defforms kind kw-id forms form-procs subs sub-procs contract-procs content-thunk)
(parameterize ([current-meta-list '(... ...+)])
(make-box-splice
(cons
@@ -346,19 +423,19 @@
(make-table
boxed-style
(append
- (map
- (lambda (form form-proc)
- (list
- (make-flow
- (list
- ((or form-proc
- (lambda (x)
- (make-omitable-paragraph
- (list (to-element `(,x . ,(cdr form)))))))
- (and kw-id
- (eq? form (car forms))
- (defform-site kw-id)))))))
- forms form-procs)
+ (for/list ([form (in-list forms)]
+ [form-proc (in-list form-procs)]
+ [i (in-naturals)])
+ (list
+ ((if (zero? i) (add-background-label (or kind "syntax")) values)
+ (list
+ ((or form-proc
+ (lambda (x)
+ (make-omitable-paragraph
+ (list (to-element `(,x . ,(cdr form)))))))
+ (and kw-id
+ (eq? form (car forms))
+ (defform-site kw-id)))))))
(if (null? sub-procs)
null
(list (list flow-empty-line)
diff --git a/collects/scribble/private/manual-proc.rkt b/collects/scribble/private/manual-proc.rkt
index 3665333d..fe910929 100644
--- a/collects/scribble/private/manual-proc.rkt
+++ b/collects/scribble/private/manual-proc.rkt
@@ -113,29 +113,38 @@
"expected a result contract, found a string" #'c)
#'(racketblock0 c))]))
-(define-syntax-rule (defproc (id arg ...) result desc ...)
- (defproc* [[(id arg ...) result]] desc ...))
+(define-syntax defproc
+ (syntax-rules ()
+ [(_ #:kind kind (id arg ...) result desc ...)
+ (defproc* #:kind kind [[(id arg ...) result]] desc ...)]
+ [(_ (id arg ...) result desc ...)
+ (defproc* [[(id arg ...) result]] desc ...)]))
(define-syntax defproc*
(syntax-rules ()
- [(_ [[proto result] ...] desc ...)
- (defproc* #:mode procedure #:within #f [[proto result] ...] desc ...)]
- [(_ #:mode m #:within cl [[proto result] ...] desc ...)
+ [(_ #:kind kind #:mode m #:within cl [[proto result] ...] desc ...)
(with-togetherable-racket-variables
()
([proc proto] ...)
- (*defproc 'm (quote-syntax/loc cl)
+ (*defproc kind
+ 'm (quote-syntax/loc cl)
(list (extract-proc-id proto) ...)
'[proto ...]
(list (arg-contracts proto) ...)
(list (arg-defaults proto) ...)
(list (lambda () (result-contract result)) ...)
- (lambda () (list desc ...))))]))
+ (lambda () (list desc ...))))]
+ [(_ #:mode m #:within cl [[proto result] ...] desc ...)
+ (defproc* #:kind #f #:mode m #:within cl [[proto result] ...] desc ...)]
+ [(_ #:kind kind [[proto result] ...] desc ...)
+ (defproc* #:kind kind #:mode procedure #:within #f [[proto result] ...] desc ...)]
+ [(_ [[proto result] ...] desc ...)
+ (defproc* #:kind #f #:mode procedure #:within #f [[proto result] ...] desc ...)]))
(define-struct arg
(special? kw id optional? starts-optional? ends-optional? num-closers))
-(define (*defproc mode within-id
+(define (*defproc kind mode within-id
stx-ids prototypes arg-contractss arg-valss result-contracts
content-thunk)
(define max-proto-width (current-display-width))
@@ -336,91 +345,97 @@
. >= . (- max-proto-width 7)))
(define end (list flow-spacer (to-flow 'rarr)
flow-spacer (make-flow (list res))))
+ (define (get-label)
+ (case mode
+ [(new make) "constructor"]
+ [(send) "method"]
+ [else (or kind "procedure")]))
(append
(list
(list
- (make-flow
- (if short?
- ;; The single-line case:
- (make-table-if-necessary
- "prototype"
- (list
- (cons
- (to-flow
- (make-element
- #f
- `(,(make-openers (add1 p-depth))
- ,tagged
- ,@(if (null? args)
- (list (make-closers p-depth))
- (append-map (lambda (arg)
- (list spacer ((arg->elem #t) arg)))
- args))
- ,(racketparenfont ")"))))
- (if result-next-line? null end))))
- ;; The multi-line case:
- (let ([not-end (if result-next-line?
- (list flow-spacer)
- (list flow-spacer flow-spacer
- flow-spacer flow-spacer))]
- [one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . 60))])
- (list
- (make-table
+ ((if first? (add-background-label (get-label)) values)
+ (make-flow
+ (if short?
+ ;; The single-line case:
+ (make-table-if-necessary
"prototype"
- (cons
+ (list
(cons
(to-flow
(make-element
#f
- (list
- (make-openers (add1 p-depth))
- tagged)))
- (if one-ok?
- (list*
- (if (arg-starts-optional? (car args))
- (to-flow (make-element #f (list spacer "[")))
- flow-spacer)
- (to-flow ((arg->elem #f) (car args)))
- not-end)
- (list* 'cont 'cont not-end)))
- (let loop ([args (if one-ok? (cdr args) args)])
- (if (null? args)
- null
- (let ([dots-next?
- (or (and (pair? (cdr args))
- (arg-special? (cadr args))
- (not (eq? '_...superclass-args...
- (arg-id (cadr args))))))])
- (cons
- (list*
- (if (eq? mode 'new)
- (flow-spacer/n 3)
- flow-spacer)
- (if (arg-starts-optional? (car args))
- (to-flow (make-element #f (list spacer "[")))
- flow-spacer)
- (let ([a ((arg->elem #f) (car args))]
- [next (if dots-next?
- (make-element
- #f (list spacer
- ((arg->elem #f)
- (cadr args))))
- "")])
- (to-flow
- (cond
- [(null? ((if dots-next? cddr cdr) args))
- (make-element
- #f
- (list a next (racketparenfont ")")))]
- [(equal? next "") a]
- [else
- (make-element #f (list a next))])))
- (if (and (null? ((if dots-next? cddr cdr) args))
- (not result-next-line?))
- end
- not-end))
- (loop ((if dots-next? cddr cdr)
- args))))))))))))))
+ `(,(make-openers (add1 p-depth))
+ ,tagged
+ ,@(if (null? args)
+ (list (make-closers p-depth))
+ (append-map (lambda (arg)
+ (list spacer ((arg->elem #t) arg)))
+ args))
+ ,(racketparenfont ")"))))
+ (if result-next-line? null end))))
+ ;; The multi-line case:
+ (let ([not-end (if result-next-line?
+ (list flow-spacer)
+ (list flow-spacer flow-spacer
+ flow-spacer flow-spacer))]
+ [one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . 60))])
+ (list
+ (make-table
+ "prototype"
+ (cons
+ (cons
+ (to-flow
+ (make-element
+ #f
+ (list
+ (make-openers (add1 p-depth))
+ tagged)))
+ (if one-ok?
+ (list*
+ (if (arg-starts-optional? (car args))
+ (to-flow (make-element #f (list spacer "[")))
+ flow-spacer)
+ (to-flow ((arg->elem #f) (car args)))
+ not-end)
+ (list* 'cont 'cont not-end)))
+ (let loop ([args (if one-ok? (cdr args) args)])
+ (if (null? args)
+ null
+ (let ([dots-next?
+ (or (and (pair? (cdr args))
+ (arg-special? (cadr args))
+ (not (eq? '_...superclass-args...
+ (arg-id (cadr args))))))])
+ (cons
+ (list*
+ (if (eq? mode 'new)
+ (flow-spacer/n 3)
+ flow-spacer)
+ (if (arg-starts-optional? (car args))
+ (to-flow (make-element #f (list spacer "[")))
+ flow-spacer)
+ (let ([a ((arg->elem #f) (car args))]
+ [next (if dots-next?
+ (make-element
+ #f (list spacer
+ ((arg->elem #f)
+ (cadr args))))
+ "")])
+ (to-flow
+ (cond
+ [(null? ((if dots-next? cddr cdr) args))
+ (make-element
+ #f
+ (list a next (racketparenfont ")")))]
+ [(equal? next "") a]
+ [else
+ (make-element #f (list a next))])))
+ (if (and (null? ((if dots-next? cddr cdr) args))
+ (not result-next-line?))
+ end
+ not-end))
+ (loop ((if dots-next? cddr cdr)
+ args)))))))))))))))
(if result-next-line?
(list (list (make-flow (make-table-if-necessary "prototype"
(list end)))))
@@ -489,11 +504,11 @@
(content-thunk))))
(define-syntax-rule (defparam id arg contract desc ...)
- (defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...))
+ (defproc* #:kind "parameter" ([(id) contract] [(id [arg contract]) void?]) desc ...))
(define-syntax-rule (defparam* id arg in-contract out-contract desc ...)
- (defproc* ([(id) out-contract] [(id [arg in-contract]) void?]) desc ...))
+ (defproc* #:kind "parameter" ([(id) out-contract] [(id [arg in-contract]) void?]) desc ...))
(define-syntax-rule (defboolparam id arg desc ...)
- (defproc* ([(id) boolean?] [(id [arg any/c]) void?]) desc ...))
+ (defproc* #:kind "parameter" ([(id) boolean?] [(id [arg any/c]) void?]) desc ...))
;; ----------------------------------------
@@ -585,229 +600,231 @@
(make-table
boxed-style
(cons
- (list (make-flow
- (list
- (let* ([the-name
- (let ([just-name
- (make-target-element*
- make-toc-target-element
- (if (pair? name)
- (car (syntax-e stx-id))
- stx-id)
- (annote-exporting-library
- (to-element
- (if (pair? name)
- (make-just-context (car name)
- (car (syntax-e stx-id)))
- stx-id)))
- (let ([name (if (pair? name) (car name) name)])
- (list* (list 'info name)
- (list 'type 'struct: name)
- (list 'predicate name '?)
- (append
- (if cname-id
- (list (list 'constructor (syntax-e cname-id)))
- null)
- (map (lambda (f)
- (list 'accessor name '-
- (field-name f)))
- fields)
- (filter-map
- (lambda (f)
- (if (or (not immutable?)
- (and (pair? (car f))
- (memq '#:mutable
- (car f))))
- (list 'mutator 'set- name '-
- (field-name f) '!)
- #f))
- fields)))))])
- (if (pair? name)
- (make-element
- #f
- (list just-name
- (hspace 1)
- (to-element
- (make-just-context
- (cadr name)
- (cadr (syntax-e stx-id))))))
- just-name))]
- [sym-length (lambda (s)
- (string-length (symbol->string s)))]
- [short-width
- (apply + (length fields) 8
- (append
- (map sym-length
- (append (if (pair? name) name (list name))
- (map field-name fields)))
- (map (lambda (f)
- (if (pair? (car f))
- (+ 3 2 (string-length (keyword->string
- (cadar f))))
- 0))
- fields)))])
- (if (and (short-width . < . max-proto-width)
- immutable?
- (not transparent?)
- (not cname-id))
- (make-omitable-paragraph
- (list
- (to-element
- `(,(racket struct)
- ,the-name
- ,(map field-view fields)))))
- (let* ([one-right-column?
- (or (null? fields)
- (short-width . < . max-proto-width))]
- [a-right-column
- (lambda (c)
- (if one-right-column?
- (list flow-spacer flow-spacer c)
- (list flow-spacer flow-spacer c 'cont 'cont)))]
- [split-field-line?
- (max-proto-width . < . (+ 8
- (if (pair? name)
- (+ (sym-length (car name))
- 1
- (sym-length (cadr name)))
- (sym-length name))
- 1
- (if (pair? fields)
- (sym-length (field-name (car fields)))
- 0)
- 1))])
- (make-table
- (if one-right-column?
+ (list
+ ((add-background-label "struct")
+ (make-flow
+ (list
+ (let* ([the-name
+ (let ([just-name
+ (make-target-element*
+ make-toc-target-element
+ (if (pair? name)
+ (car (syntax-e stx-id))
+ stx-id)
+ (annote-exporting-library
+ (to-element
+ (if (pair? name)
+ (make-just-context (car name)
+ (car (syntax-e stx-id)))
+ stx-id)))
+ (let ([name (if (pair? name) (car name) name)])
+ (list* (list 'info name)
+ (list 'type 'struct: name)
+ (list 'predicate name '?)
+ (append
+ (if cname-id
+ (list (list 'constructor (syntax-e cname-id)))
+ null)
+ (map (lambda (f)
+ (list 'accessor name '-
+ (field-name f)))
+ fields)
+ (filter-map
+ (lambda (f)
+ (if (or (not immutable?)
+ (and (pair? (car f))
+ (memq '#:mutable
+ (car f))))
+ (list 'mutator 'set- name '-
+ (field-name f) '!)
+ #f))
+ fields)))))])
+ (if (pair? name)
+ (make-element
#f
- ;; Shift all extra width to last column:
- (make-style #f (list
- (make-table-columns
- (for/list ([i 5])
- (if (i . < . 4)
- (make-style #f (list (column-attributes '((width . "0*")))))
- (make-style #f null)))))))
+ (list just-name
+ (hspace 1)
+ (to-element
+ (make-just-context
+ (cadr name)
+ (cadr (syntax-e stx-id))))))
+ just-name))]
+ [sym-length (lambda (s)
+ (string-length (symbol->string s)))]
+ [short-width
+ (apply + (length fields) 8
+ (append
+ (map sym-length
+ (append (if (pair? name) name (list name))
+ (map field-name fields)))
+ (map (lambda (f)
+ (if (pair? (car f))
+ (+ 3 2 (string-length (keyword->string
+ (cadar f))))
+ 0))
+ fields)))])
+ (if (and (short-width . < . max-proto-width)
+ immutable?
+ (not transparent?)
+ (not cname-id))
+ (make-omitable-paragraph
+ (list
+ (to-element
+ `(,(racket struct)
+ ,the-name
+ ,(map field-view fields)))))
+ (let* ([one-right-column?
+ (or (null? fields)
+ (short-width . < . max-proto-width))]
+ [a-right-column
+ (lambda (c)
+ (if one-right-column?
+ (list flow-spacer flow-spacer c)
+ (list flow-spacer flow-spacer c 'cont 'cont)))]
+ [split-field-line?
+ (max-proto-width . < . (+ 8
+ (if (pair? name)
+ (+ (sym-length (car name))
+ 1
+ (sym-length (cadr name)))
+ (sym-length name))
+ 1
+ (if (pair? fields)
+ (sym-length (field-name (car fields)))
+ 0)
+ 1))])
+ (make-table
+ (if one-right-column?
+ #f
+ ;; Shift all extra width to last column:
+ (make-style #f (list
+ (make-table-columns
+ (for/list ([i 5])
+ (if (i . < . 4)
+ (make-style #f (list (column-attributes '((width . "0*")))))
+ (make-style #f null)))))))
+ (append
+ (list
(append
- (list
- (append
- (list (to-flow (make-element #f
- (list
- (racketparenfont "(")
- (racket struct))))
- flow-spacer)
- (if one-right-column?
- (list (to-flow (make-element
- #f
- (list* the-name
- spacer
- (to-element (map field-view
- fields))
- (if (and immutable?
- (not transparent?)
- (not cname-id))
- (list (racketparenfont ")"))
- null)))))
- (if split-field-line?
- (list (to-flow (make-element 'no-break the-name))
- 'cont
- 'cont)
- (list (to-flow (make-element 'no-break the-name))
- (to-flow (make-element
- #f (list spacer (racketparenfont "("))))
- (to-flow (make-element 'no-break
- (let ([f (to-element (field-view (car fields)))])
- (if (null? (cdr fields))
- (list f (racketparenfont ")"))
- f)))))))))
- (if split-field-line?
- (list
- (list flow-spacer flow-spacer flow-spacer
- (to-flow (make-element
- #f (list spacer (racketparenfont "("))))
- (to-flow (make-element 'no-break
- (let ([f (to-element (field-view (car fields)))])
- (if (null? (cdr fields))
- (list f (racketparenfont ")"))
- f))))))
- null)
- (if (short-width . < . max-proto-width)
- null
- (let loop ([fields (if (null? fields)
- fields (cdr fields))])
- (if (null? fields)
- null
- (cons
- (let ([fld (car fields)])
- (list flow-spacer flow-spacer
- flow-spacer flow-spacer
- (to-flow
- (let ([e (to-element (field-view fld))])
- (if (null? (cdr fields))
- (make-element
- #f
- (list e (racketparenfont
- (if (and immutable?
- (not transparent?)
- (not cname-id))
- "))"
- ")"))))
- e)))))
- (loop (cdr fields))))))
- (if cname-id
- (let ([kw (to-element (if extra-cname?
- '#:extra-constructor-name
- '#:constructor-name))]
- [nm (to-element cname-id)]
- [close? (and immutable?
- (not transparent?))])
- (if (max-proto-width . < . (+ 8 ; "(struct "
- 1 ; space between kw & name
- (element-width kw)
- (element-width nm)
- (if close? 1 0)))
- ;; use two lines
- (list (a-right-column (to-flow kw))
- (a-right-column
+ (list (to-flow (make-element #f
+ (list
+ (racketparenfont "(")
+ (racket struct))))
+ flow-spacer)
+ (if one-right-column?
+ (list (to-flow (make-element
+ #f
+ (list* the-name
+ spacer
+ (to-element (map field-view
+ fields))
+ (if (and immutable?
+ (not transparent?)
+ (not cname-id))
+ (list (racketparenfont ")"))
+ null)))))
+ (if split-field-line?
+ (list (to-flow (make-element 'no-break the-name))
+ 'cont
+ 'cont)
+ (list (to-flow (make-element 'no-break the-name))
+ (to-flow (make-element
+ #f (list spacer (racketparenfont "("))))
+ (to-flow (make-element 'no-break
+ (let ([f (to-element (field-view (car fields)))])
+ (if (null? (cdr fields))
+ (list f (racketparenfont ")"))
+ f)))))))))
+ (if split-field-line?
+ (list
+ (list flow-spacer flow-spacer flow-spacer
+ (to-flow (make-element
+ #f (list spacer (racketparenfont "("))))
+ (to-flow (make-element 'no-break
+ (let ([f (to-element (field-view (car fields)))])
+ (if (null? (cdr fields))
+ (list f (racketparenfont ")"))
+ f))))))
+ null)
+ (if (short-width . < . max-proto-width)
+ null
+ (let loop ([fields (if (null? fields)
+ fields (cdr fields))])
+ (if (null? fields)
+ null
+ (cons
+ (let ([fld (car fields)])
+ (list flow-spacer flow-spacer
+ flow-spacer flow-spacer
(to-flow
- (if close?
- (make-element #f (list nm (racketparenfont ")")))
- nm))))
- ;; use one line
- (list (a-right-column
- (to-flow (make-element
+ (let ([e (to-element (field-view fld))])
+ (if (null? (cdr fields))
+ (make-element
+ #f
+ (list e (racketparenfont
+ (if (and immutable?
+ (not transparent?)
+ (not cname-id))
+ "))"
+ ")"))))
+ e)))))
+ (loop (cdr fields))))))
+ (if cname-id
+ (let ([kw (to-element (if extra-cname?
+ '#:extra-constructor-name
+ '#:constructor-name))]
+ [nm (to-element cname-id)]
+ [close? (and immutable?
+ (not transparent?))])
+ (if (max-proto-width . < . (+ 8 ; "(struct "
+ 1 ; space between kw & name
+ (element-width kw)
+ (element-width nm)
+ (if close? 1 0)))
+ ;; use two lines
+ (list (a-right-column (to-flow kw))
+ (a-right-column
+ (to-flow
+ (if close?
+ (make-element #f (list nm (racketparenfont ")")))
+ nm))))
+ ;; use one line
+ (list (a-right-column
+ (to-flow (make-element
+ #f
+ (append
+ (list kw
+ (hspace 1)
+ nm)
+ (if close?
+ (list (racketparenfont ")"))
+ null))))))))
+ null)
+ (cond
+ [(and (not immutable?) transparent?)
+ (list
+ (a-right-column (to-flow (to-element '#:mutable)))
+ (a-right-column (to-flow (make-element
#f
- (append
- (list kw
- (hspace 1)
- nm)
- (if close?
- (list (racketparenfont ")"))
- null))))))))
- null)
- (cond
- [(and (not immutable?) transparent?)
- (list
- (a-right-column (to-flow (to-element '#:mutable)))
- (a-right-column (to-flow (make-element
- #f
- (list (if prefab?
- (to-element '#:prefab)
- (to-element '#:transparent))
- (racketparenfont ")"))))))]
- [(not immutable?)
- (list
- (a-right-column (to-flow (make-element
- #f
- (list (to-element '#:mutable)
- (racketparenfont ")"))))))]
- [transparent?
- (list
- (a-right-column (to-flow (make-element
- #f
- (list (if prefab?
- (to-element '#:prefab)
- (to-element '#:transparent))
- (racketparenfont ")"))))))]
- [else null])))))))))
+ (list (if prefab?
+ (to-element '#:prefab)
+ (to-element '#:transparent))
+ (racketparenfont ")"))))))]
+ [(not immutable?)
+ (list
+ (a-right-column (to-flow (make-element
+ #f
+ (list (to-element '#:mutable)
+ (racketparenfont ")"))))))]
+ [transparent?
+ (list
+ (a-right-column (to-flow (make-element
+ #f
+ (list (if prefab?
+ (to-element '#:prefab)
+ (to-element '#:transparent))
+ (racketparenfont ")"))))))]
+ [else null]))))))))))
(map (lambda (v field-contract)
(cond
[(pair? v)
@@ -832,23 +849,33 @@
;; ----------------------------------------
-(define-syntax-rule (defthing id result desc ...)
- (with-togetherable-racket-variables
- ()
- ()
- (*defthing (list (quote-syntax/loc id)) (list 'id) #f
- (list (racketblock0 result))
- (lambda () (list desc ...)))))
+(define-syntax defthing
+ (syntax-rules ()
+ [(_ #:kind kind id result desc ...)
+ (with-togetherable-racket-variables
+ ()
+ ()
+ (*defthing kind
+ (list (quote-syntax/loc id)) (list 'id) #f
+ (list (racketblock0 result))
+ (lambda () (list desc ...))))]
+ [(_ id result desc ...)
+ (defthing #:kind #f id result desc ...)]))
-(define-syntax-rule (defthing* ([id result] ...) desc ...)
- (with-togetherable-racket-variables
- ()
- ()
- (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f
- (list (racketblock0 result) ...)
- (lambda () (list desc ...)))))
+(define-syntax defthing*
+ (syntax-rules ()
+ [(_ #:kind kind ([id result] ...) desc ...)
+ (with-togetherable-racket-variables
+ ()
+ ()
+ (*defthing kind
+ (list (quote-syntax/loc id) ...) (list 'id ...) #f
+ (list (racketblock0 result) ...)
+ (lambda () (list desc ...))))]
+ [(_ ([id result] ...) desc ...)
+ (defthing* #:kind #f ([id result] ...) desc ...)]))
-(define (*defthing stx-ids names form? result-contracts content-thunk
+(define (*defthing kind stx-ids names form? result-contracts content-thunk
[result-values (map (lambda (x) #f) result-contracts)])
(make-box-splice
(cons
@@ -857,9 +884,13 @@
(list
(make-table
boxed-style
- (map
- (lambda (stx-id name result-contract result-value)
- (list
+ (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"
@@ -930,12 +961,11 @@
(to-flow (make-element #f (list spacer "=" spacer)))
(make-flow (list result-block)))))
'cont))
- null)))))))
- stx-ids names result-contracts result-values))))
+ null)))))))))))
(content-thunk))))
-(define (defthing/proc id contract descs)
- (*defthing (list id) (list (syntax-e id)) #f (list contract)
+(define (defthing/proc kind id contract descs)
+ (*defthing kind (list id) (list (syntax-e id)) #f (list contract)
(lambda () descs)))
(define (make-target-element* inner-make-target-element stx-id content wrappers)
diff --git a/collects/scribble/private/manual-unit.rkt b/collects/scribble/private/manual-unit.rkt
index a336e62e..0f1e4a48 100644
--- a/collects/scribble/private/manual-unit.rkt
+++ b/collects/scribble/private/manual-unit.rkt
@@ -40,6 +40,7 @@
(define (*defsignature stx-id supers body-thunk indent?)
(*defthing
+ "signature"
(list stx-id)
(list (syntax-e stx-id))
#t
diff --git a/collects/scribble/private/manual-vars.rkt b/collects/scribble/private/manual-vars.rkt
index 6cfb7b7f..6c1d733b 100644
--- a/collects/scribble/private/manual-vars.rkt
+++ b/collects/scribble/private/manual-vars.rkt
@@ -3,8 +3,9 @@
"../scheme.rkt"
"../struct.rkt"
(only-in "../core.rkt"
- make-style style-name
- nested-flow? nested-flow-blocks nested-flow-style)
+ make-style style-name style-properties
+ nested-flow? nested-flow-blocks nested-flow-style
+ make-nested-flow)
"../html-properties.rkt"
racket/contract/base
(for-syntax scheme/base
@@ -21,7 +22,8 @@
with-racket-variables
with-togetherable-racket-variables
vertical-inset-style
- boxed-style)
+ boxed-style
+ add-background-label)
(define vertical-inset-style
(make-style 'vertical-inset null))
@@ -29,6 +31,44 @@
(define boxed-style
(make-style 'boxed (list (make-attributes (list (cons 'class "RBoxed"))))))
+(define ((add-background-label what) l)
+ (list
+ (make-nested-flow
+ (make-style "RBackgroundLabel" (list 'decorative 'command (alt-tag "div")
+ (make-attributes '((class . "SIEHidden")))))
+ (list
+ (make-nested-flow
+ (make-style "RBackgroundLabelInner" (list (alt-tag "div")))
+ (list (make-omitable-paragraph what)))))
+ (let* ([a (car l)]
+ [remake (if (paragraph? a)
+ (lambda (sa)
+ (paragraph
+ (sa (paragraph-style a))
+ (paragraph-content a)))
+ (lambda (sa)
+ (table
+ (sa (table-style a))
+ (table-blockss a))))])
+ (remake
+ (lambda (s)
+ (make-style (style-name s)
+ (let ([p (style-properties s)])
+ (if (ormap attributes? p)
+ (for/list ([i (in-list p)])
+ (if (attributes? i)
+ (let ([al (attributes-assoc i)])
+ (if (assq 'class al)
+ (for/list ([a (in-list al)])
+ (if (eq? (car a) 'class)
+ (cons 'class (string-append (cdr a) " RForeground"))
+ a))
+ (attributes (cons '(class . "RForeground")
+ al))))
+ i))
+ (cons (attributes '((class . "RForeground")))
+ p)))))))))
+
(begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))
(define-syntax (with-togetherable-racket-variables stx)
diff --git a/collects/scribble/racket.css b/collects/scribble/racket.css
index 3bb29352..350deffe 100644
--- a/collects/scribble/racket.css
+++ b/collects/scribble/racket.css
@@ -14,6 +14,11 @@
font-family: serif;
}
+/* Sans-serif: */
+.RBackgroundLabelInner {
+ font-family: sans-serif;
+}
+
/* ---------------------------------------- */
/* Inherited methods, left margin */
@@ -199,3 +204,30 @@
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
+
+/* ---------------------------------------- */
+/* For background labels */
+
+.RBackgroundLabel {
+ float: right;
+ width: 0px;
+}
+
+.RBackgroundLabelInner {
+ position: relative;
+ width: 25em;
+ left: -25.5em;
+ top: 0px;
+ text-align: right;
+ color: white;
+ z-index: 0;
+ font-weight: bold;
+ text-transform: uppercase;
+}
+
+.RForeground {
+ position: relative;
+ left: 0px;
+ top: 0px;
+ z-index: 1;
+}
diff --git a/collects/scribble/racket.tex b/collects/scribble/racket.tex
index 438ee499..b9f5990b 100644
--- a/collects/scribble/racket.tex
+++ b/collects/scribble/racket.tex
@@ -64,3 +64,6 @@
\newcommand{\Rfilename}[1]{#1}
\newenvironment{Rfilecontent}{}{}
\newcommand{\RfilecontentBox}[1]{#1}
+
+\newcommand{\RBackgroundLabel}[1]{}
+\newenvironment{RBackgroundLabelInner}{}{}
diff --git a/collects/scribble/text-render.rkt b/collects/scribble/text-render.rkt
index 025b0843..c5baffd0 100644
--- a/collects/scribble/text-render.rkt
+++ b/collects/scribble/text-render.rkt
@@ -145,12 +145,13 @@
(define/override (render-nested-flow i part ri starting-item?)
(define s (nested-flow-style i))
- (if (and s (or (eq? (style-name s) 'inset)
- (eq? (style-name s) 'code-inset)))
- (begin (printf " ")
- (parameterize ([current-indent (make-indent 2)])
- (super render-nested-flow i part ri starting-item?)))
- (super render-nested-flow i part ri starting-item?)))
+ (unless (memq 'decorative (style-properties s))
+ (if (and s (or (eq? (style-name s) 'inset)
+ (eq? (style-name s) 'code-inset)))
+ (begin (printf " ")
+ (parameterize ([current-indent (make-indent 2)])
+ (super render-nested-flow i part ri starting-item?)))
+ (super render-nested-flow i part ri starting-item?))))
(define/override (render-other i part ht)
(cond
diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl
index 4430724a..c8047202 100644
--- a/collects/scribblings/scribble/core.scrbl
+++ b/collects/scribblings/scribble/core.scrbl
@@ -607,6 +607,9 @@ The following @tech{style properties} are currently recognized:
rendering form for @tech{boxing contexts} (such as a table cell); see
@racket[box-mode].}
+ @item{@racket['decorative] --- The content of the nested flow is intended
+ for decoration. Text output skips a decorative nested flow.}
+
]}
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
index 36933db3..345ac3c4 100644
--- a/collects/scribblings/scribble/manual.scrbl
+++ b/collects/scribblings/scribble/manual.scrbl
@@ -671,7 +671,7 @@ sub-sections.}
@; ------------------------------------------------------------------------
@section[#:tag "doc-forms"]{Documenting Forms, Functions, Structure Types, and Values}
-@defform/subs[(defproc prototype
+@defform/subs[(defproc maybe-kind prototype
result-contract-expr-datum
pre-flow ...)
([prototype (id arg-spec ...)
@@ -682,6 +682,8 @@ sub-sections.}
(keyword arg-id contract-expr-datum default-expr)
ellipses
ellipses+]
+ [maybe-kind code:blank
+ (code:line #:kind kind-string-expr)]
[ellipses @#,lit-ellipses]
[ellipses+ @#,lit-ellipses+])]{
@@ -739,10 +741,18 @@ The typesetting of all information before the @racket[pre-flow]s
ignores the source layout, except that the local formatting is
preserved for contracts and default-values expressions. The information
is formatted to fit (if possible) in the number of characters specified
-by the @racket[current-display-width] parameter.}
+by the @racket[current-display-width] parameter.
+
+An optional @racket[#:kind] specification chooses the decorative
+label, which defaults to @racket["procedure"]. A @racket[#f]
+result for @racket[kind-string-expr] uses the default, otherwise
+@racket[kind-string-expr] should produce a string. An alternate
+label should be all lowercase, although the current documentation
+style converts the string to all uppercase.}
-@defform[(defproc* ([prototype
+@defform[(defproc* maybe-kind
+ ([prototype
result-contract-expr-datum] ...)
pre-flow ...)]{
@@ -756,9 +766,12 @@ 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.}
-@defform/subs[(defform maybe-id maybe-literals form-datum maybe-contracts
+@defform/subs[(defform maybe-kind maybe-id maybe-literals form-datum
+ maybe-contracts
pre-flow ...)
- ([maybe-id code:blank
+ ([maybe-kind code:blank
+ (code:line #:kind kind-string-expr)]
+ [maybe-id code:blank
(code:line #:id id)
(code:line #:id [id id-expr])]
[maybe-literals code:blank
@@ -774,6 +787,10 @@ result of @racket[id-expr]) whose syntax is described by
@racket[id], then @racket[form-datum] must have the form @racket[(id
. _datum)].
+If @racket[#:kind kind-string-expr] is supplied, it is used in the
+same way as for @racket[defproc], but the default kind is
+@racket["syntax"].
+
If @racket[#:id [id id-expr]] is supplied, then @racket[id] is the
identifier as it appears in the @racket[form-datum] (to be replaced by
a defining instance), and @racket[id-expr] produces the identifier to
@@ -808,13 +825,14 @@ The typesetting of @racket[form-datum], @racket[subform-datum], and
@racket[contract-expr-datum] preserves the source layout, like
@racket[racketblock].}
-@defform[(defform* maybe-id maybe-literals [form-datum ...+] maybe-contracts
+@defform[(defform* maybe-kind maybe-id maybe-literals [form-datum ...+]
+ maybe-contracts
pre-flow ...)]{
Like @racket[defform], but for multiple forms using the same
@racket[_id].}
-@defform[(defform/subs maybe-id maybe-literals form-datum
+@defform[(defform/subs maybe-kind maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
@@ -826,20 +844,20 @@ non-terminals shown with the @racket[_id] form. Each
@racket[clause-datum] is preserved.}
-@defform[(defform*/subs maybe-id maybe-literals [form-datum ...]
+@defform[(defform*/subs maybe-kind maybe-id maybe-literals [form-datum ...]
maybe-contracts
pre-flow ...)]{
Like @racket[defform/subs], but for multiple forms for @racket[_id].}
-@defform[(defform/none maybe-literal form-datum maybe-contracts
+@defform[(defform/none maybe-kind maybe-literal form-datum maybe-contracts
pre-flow ...)]{
Like @racket[defform], but without registering a definition.}
-@defform[(defidform id pre-flow ...)]{
+@defform[(defidform maybe-kind id pre-flow ...)]{
Like @racket[defform], but with a plain @racket[id] as the form.}
@@ -917,9 +935,14 @@ Like @racket[defparam], but the contract on a parameter argument is
@racket[boolean?].}
-@defform[(defthing id contract-expr-datum pre-flow ...)]{
+@defform[(defthing maybe-kind id contract-expr-datum pre-flow ...)]{
+
+Like @racket[defproc], but for a non-procedure binding.
+
+If @racket[#:kind kind-string-expr] is supplied as
+@racket[maybe-kind], it is used in the same way as for
+@racket[defproc], but the default kind is @racket["value"].}
-Like @racket[defproc], but for a non-procedure binding.}
@deftogether[(
@defform[ (defstruct* struct-name ([field-name contract-expr-datum] ...)