From d7c846e425ea991ef9e79a3112962dc890b2f034 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 11 Jun 2007 01:52:02 +0000 Subject: [PATCH] revert doc format of procedure specs svn: r6570 original commit: 6683f058897bdc84b67a052d5a3e013fd156f88d --- collects/scribble/manual.ss | 246 +++++++++------------ collects/scribblings/scribble/basic.scrbl | 23 +- collects/scribblings/scribble/struct.scrbl | 22 +- 3 files changed, 140 insertions(+), 151 deletions(-) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index d6728300..1baa0260 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -160,79 +160,48 @@ (schemeresultfont "#")) (define dots0 - (make-element #f (list "..."))) + (make-element "schemeparen" (list "..."))) (define dots1 - (make-element #f (list "..." (superscript "+")))) + (make-element "schemeparen" (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 ") ...+)")) - (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) - (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)))))))))))) + (to-flow ":") + (to-flow spacer) + (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 index eae16ed3..2dcb5439 100644 --- 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 index c0ecdb97..8b6b8683 100644 --- 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. }