commit d7c846e425ea991ef9e79a3112962dc890b2f034
parent 893d7d9098b1cd4f4b2e59f15b1347275f57cbc6
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 11 Jun 2007 01:52:02 +0000
revert doc format of procedure specs
svn: r6570
original commit: 6683f058897bdc84b67a052d5a3e013fd156f88d
Diffstat:
3 files changed, 141 insertions(+), 152 deletions(-)
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -160,79 +160,48 @@
(schemeresultfont "#<undefined>"))
(define dots0
- (make-element #f (list "...")))
+ (make-element "schemeparen" (list "...")))
(define dots1
- (make-element #f (list "..." (superscript "+"))))
-
- (define (to-paragraph/suffix s)
- (to-paragraph/prefix ""
- ""
- (schemeparenfont s)))
-
- (define-code schemeblock0/close (to-paragraph/suffix ")"))
- (define-code schemeblock0/close... (to-paragraph/suffix ") ..."))
- (define-code schemeblock0/close...+ (to-paragraph/suffix ") ...+"))
- (define-code schemeblock0/closeclose (to-paragraph/suffix "))"))
- (define-code schemeblock0/close...close (to-paragraph/suffix ") ...)"))
- (define-code schemeblock0/close...+close (to-paragraph/suffix ") ...+)"))
-
+ (make-element "schemeparen" (list "..." (superscript "+"))))
+
(define-syntax (arg-contract stx)
(syntax-case stx (... ...+)
- [(_ [id contract] typeset)
+ [(_ [id contract])
(identifier? #'id)
- #'(typeset contract)]
- [(_ [id contract val] typeset)
+ #'(schemeblock0 contract)]
+ [(_ [id contract val])
(identifier? #'id)
- #'(typeset contract)]
- [(_ [kw id contract] typeset)
+ #'(schemeblock0 contract)]
+ [(_ [kw id contract])
(and (keyword? (syntax-e #'kw))
(identifier? #'id))
- #'(typeset contract)]
- [(_ [kw id contract val] typeset)
+ #'(schemeblock0 contract)]
+ [(_ [kw id contract val])
(and (keyword? (syntax-e #'kw))
(identifier? #'id))
- #'(typeset contract)]
- [(_ (... ...) typeset)
+ #'(schemeblock0 contract)]
+ [(_ (... ...))
#'#f]
- [(_ (... ...+) typeset)
+ [(_ (... ...+))
#'#f]
- [(_ arg typeset)
+ [(_ arg)
(raise-syntax-error
'defproc
"bad argument form"
#'arg)]))
- (define-syntax arg-contracts
- (syntax-rules (... ...+)
- [(_) null]
- [(_ arg (... ...))
- (list (lambda () (arg-contract arg schemeblock0/close...close)))]
- [(_ arg (... ...+))
- (list (lambda () (arg-contract arg schemeblock0/close...+close)))]
- [(_ arg (... ...) . rest)
- (cons (lambda () (arg-contract arg schemeblock0/close...))
- (arg-contracts . rest))]
- [(_ arg (... ...+) . rest)
- (cons (lambda () (arg-contract arg schemeblock0/close...+))
- (arg-contracts . rest))]
- [(_ arg)
- (list (lambda () (arg-contract arg schemeblock0/closeclose)))]
- [(_ arg . rest)
- (cons (lambda () (arg-contract arg schemeblock0/close))
- (arg-contracts . rest))]))
-
(define-syntax defproc
(syntax-rules ()
[(_ (id arg ...) result desc ...)
(*defproc '[(id arg ...)]
- (list (arg-contracts arg ...))
+ (list (list (lambda () (arg-contract arg)) ...))
(list (lambda () (schemeblock0 result)))
(lambda () (list desc ...)))]))
(define-syntax defproc*
(syntax-rules ()
[(_ [[(id arg ...) result] ...] desc ...)
(*defproc '[(id arg ...) ...]
- (list (arg-contracts arg ...) ...)
+ (list (list (lambda () (arg-contract arg)) ...) ...)
(list (lambda () (schemeblock0 result)) ...)
(lambda () (list desc ...)))]))
(define-syntax defstruct
@@ -307,6 +276,8 @@
(syntax-rules ()
[(_ id) (*var 'id)]))
+
+
(define (*defproc prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)]
[has-optional? (lambda (arg)
@@ -315,7 +286,20 @@
3
2))))]
[to-flow (lambda (e)
- (make-flow (list (make-paragraph (list e)))))])
+ (make-flow (list (make-paragraph (list e)))))]
+ [arg->elem (lambda (v)
+ (cond
+ [(pair? v)
+ (if (keyword? (car v))
+ (make-element #f (list (to-element (car v))
+ (hspace 1)
+ (to-element (cadr v))))
+ (to-element (car v)))]
+ [(eq? v '...+)
+ dots1]
+ [(eq? v '...)
+ dots0]
+ [else v]))])
(parameterize ([current-variable-list
(map (lambda (i)
(and (pair? i)
@@ -327,97 +311,86 @@
(cons
(make-table
'boxed
- (apply
+ (apply
append
(map
(lambda (prototype arg-contracts result-contract first?)
- (let ([name (if first?
- (make-target-element
- #f
- (list (to-element (car prototype)))
- (register-scheme-definition (car prototype)))
- (to-element (car prototype)))])
- (list
- (list
- (make-flow
- (list
- (if (null? (cdr prototype))
- (make-table
- #f
- (list (list
- (make-flow
- (list
- (make-paragraph
- (list (schemeparenfont "(")
- name
- (schemeparenfont ")"))))))))
- (make-table
- #f
- (let loop ([args (cdr prototype)]
- [arg-contracts arg-contracts]
- [first? #t])
- (let* ([a (car args)]
- [v (if (keyword? (car a))
- (cdr a)
- a)]
- [dots (and (pair? (cdr args))
- (not (pair? (cadr args)))
- (cadr args))])
- (cons
- (list (if first?
- (make-flow
- (list
- (make-paragraph
- (list
- (schemeparenfont "(")
- name
- spacer))))
- (to-flow spacer))
- (make-flow
- (list
- (make-table
- '((valignment baseline baseline baseline))
- (list
+ (append
+ (list
+ (list (make-flow
+ (list
+ (make-table
+ '((valignment top top top top top))
+ (list
+ (list
+ (to-flow
+ (let-values ([(required optional more-required)
+ (let loop ([a (cdr prototype)][r-accum null])
+ (if (or (null? a)
+ (and (has-optional? (car a))))
+ (let ([req (reverse r-accum)])
+ (let loop ([a a][o-accum null])
+ (if (or (null? a)
+ (not (has-optional? (car a))))
+ (values req (reverse o-accum) a)
+ (loop (cdr a) (cons (car a) o-accum)))))
+ (loop (cdr a) (cons (car a) r-accum))))])
+ (to-element (append
+ (list (if first?
+ (make-target-element
+ #f
+ (list (to-element (car prototype)))
+ (register-scheme-definition (car prototype)))
+ (to-element (car prototype))))
+ (map arg->elem required)
+ (if (null? optional)
+ null
+ (list
+ (to-element
+ (syntax-property
+ (syntax-ize (map arg->elem optional) 0)
+ 'paren-shape
+ #\?))))
+ (map arg->elem more-required)))))
+ (to-flow spacer)
+ (to-flow 'rarr)
+ (to-flow spacer)
+ (make-flow (list (result-contract))))))))))
+ (apply append
+ (map (lambda (v arg-contract)
+ (cond
+ [(pair? v)
+ (list
+ (list
+ (make-flow
+ (list
+ (make-table
+ `((valignment baseline baseline baseline baseline
+ baseline baseline
+ ,@(if (has-optional? v)
+ '(baseline baseline baseline baseline)
+ null)))
+ (list
+ (let ([v (if (keyword? (car v))
+ (cdr v)
+ v)])
+ (append
(list
- (make-flow
- (list
- (make-paragraph
- (append
- (list (schemeparenfont "("))
- (if (keyword? (car a))
- (list (to-element (car a)) spacer)
- null)
- (list (schemefont " "))
- (if (has-optional? a)
- (list (schemeparenfont "["))
- null)
- (list (to-element (car v)))
- (if (has-optional? a)
- (list spacer
- (to-element (caddr v))
- (schemeparenfont "]"))
- null)))))
+ (to-flow (hspace 2))
+ (to-flow (arg->elem v))
+ (to-flow spacer)
+ (to-flow ":")
(to-flow spacer)
- (make-flow
- ;; Note: arg-contract includes closing paren for arg,
- ;; as well as dots or closing paren for arg sequence
- (list ((car arg-contracts))))))))))
- (let ([next (if dots
- (cddr args)
- (cdr args))])
- (if (null? next)
- null
- (loop next
- ((if dots cddr cdr) arg-contracts)
- #f)))))))))))
- (list
- (make-flow
- (list
- (make-table
- #f
- (list (list (to-flow spacer)
- (to-flow spacer)
- (make-flow (list (result-contract))))))))))))
+ (make-flow (list (arg-contract))))
+ (if (has-optional? v)
+ (list (to-flow spacer)
+ (to-flow "=")
+ (to-flow spacer)
+ (to-flow (to-element (caddr v))))
+ null)))))))))]
+ [else null]))
+ (cdr prototype)
+ arg-contracts))))
prototypes
arg-contractss
result-contracts
@@ -496,11 +469,8 @@
(list (make-target-element
#f
(list (to-element name))
- (register-scheme-definition name)))))))
- (list (make-flow
- (list
- (make-paragraph
- (list spacer spacer
+ (register-scheme-definition name))
+ spacer ":" spacer
(to-element result-contract))))))))
(content-thunk))))
diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl
@@ -3,7 +3,7 @@
@require["utils.ss"]
@require-for-syntax[mzscheme]
-@define-syntax[def-title-like
+@define-syntax[def-section-like
(syntax-rules ()
[(_ id result/c x ...) (defproc (id [#:tag tag (or/c false/c string?) #f]
[pre-content any/c] (... ...+))
@@ -44,24 +44,27 @@ have Scribble's @file{scheme.ss} and @file{manual.ss}).
@section{Document Structure}
-@def-title-like[title title-decl?]{ Generates a @scheme[title-decl] to
+@defproc[(title [#:tag tag (or/c false/c string?) #f]
+ [#:style style any/c #f]
+ [pre-content any/c] ...+)
+ title-decl?]{ Generates a @scheme[title-decl] to
be picked up by @scheme[decode] or @scheme[decode-part]. The
@scheme[pre-content]s list is parsed with @scheme[decode-content] for
the title content. If @scheme[tag] is @scheme[#f], a tag string is
generated automatically from the content. The tag string is combined
- with the symbol @scheme['section] to form the full tag.}
+ with the symbol @scheme['part] to form the full tag.}
-@def-title-like[section section-start?]{ Like @scheme[title], but
- generates a @scheme[section-start] of depth @scheme[0] to be by
+@def-section-like[section part-start?]{ Like @scheme[title], but
+ generates a @scheme[part-start] of depth @scheme[0] to be by
@scheme[decode] or @scheme[decode-part].}
-@def-title-like[subsection section-start?]{ Like @scheme[section], but
- generates a @scheme[section-start] of depth @scheme[1].}
+@def-section-like[subsection part-start?]{ Like @scheme[section], but
+ generates a @scheme[part-start] of depth @scheme[1].}
-@def-title-like[subsubsection section-start?]{ Like @scheme[section], but
- generates a @scheme[section-start] of depth @scheme[2].}
+@def-section-like[subsubsection part-start?]{ Like @scheme[section], but
+ generates a @scheme[part-start] of depth @scheme[2].}
-@def-title-like[subsubsub*section paragraph?]{ Similar to
+@def-section-like[subsubsub*section paragraph?]{ Similar to
@scheme[section], but merely generates a paragraph that looks like an
unnumbered section heading (for when the nesting gets too deep to
include in a table of contents).}
diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl
@@ -4,7 +4,7 @@
@title[#:tag "struct"]{Document Structures}
-A single document is reprsented as a @defterm{part}:
+A single document is represented as a @defterm{part}:
@itemize{
@@ -19,7 +19,7 @@ A single document is reprsented as a @defterm{part}:
of @defterm{flow element}s.}
@item{A @defterm{flow element} is either a @defterm{table}, an
- @defterm{itemization}, @defterm{paragraph}, or a
+ @defterm{itemization}, @defterm{blockquote}, @defterm{paragraph}, or a
@defterm{delayed flow element}.
@itemize{
@@ -30,6 +30,10 @@ A single document is reprsented as a @defterm{part}:
@item{A @defterm{itemization} is an instance of @scheme[itemization];
it has a list of flows.}
+ @item{A @defterm{blockquote} is an instance of
+ @scheme[blockquote]; it has list of flow elements that
+ are indented according to a specified style.}
+
@item{A @defterm{paragraph} is an instance of @scheme[paragraph]; it
has a list of @defterm{element}s.
@@ -128,6 +132,10 @@ particular source module just as easily defines a subsection
}
+@defstruct[(styled-part part) ([style any/c])]{
+
+}
+
@defstruct[flow ([paragraphs (listof flow-element?)])]{
}
@@ -136,6 +144,9 @@ particular source module just as easily defines a subsection
}
+@defstruct[(styled-paragraph paragraph) ([style any/c])]{
+}
+
@defstruct[table ([style any/c]
[flowss (listof (listof flow?))])]{
@@ -157,6 +168,11 @@ section, and the last argument correspond to global information
}
+@defstruct[blockquote ([style any/c]
+ [flows (listof flow-element?)])]{
+
+}
+
@defstruct[element ([style any/c]
[content list?])]{
@@ -198,7 +214,7 @@ rendered first.
@defproc[(flow-element? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @scheme[paragraph],
-@scheme[table], @scheme[itemization], or
+@scheme[table], @scheme[itemization], @scheme[blockquote], or
@scheme[delayed-flow-element], @scheme[#f] otherwise.
}
