doc work, including improved defproc layout in the case of lots of arguments

svn: r6719

original commit: 71685a45879de8bc22e94b2a2888ef8fb77ed918
This commit is contained in:
Matthew Flatt 2007-06-22 22:56:39 +00:00
parent dcc29be853
commit cd3fb95c05
4 changed files with 113 additions and 40 deletions

View File

@ -279,7 +279,7 @@
(content->string (part-title-content d) (content->string (part-title-content d)
this d ht)) this d ht))
"_"))]) "_"))])
(when ((string-length fn) . >= . 100) (when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn)) (error "file name too long (need a tag):" fn))
fn)) fn))

View File

@ -87,8 +87,9 @@
"")) ""))
(render-content (part-title-content d) d ht) (render-content (part-title-content d) d ht)
(printf "}")) (printf "}"))
#;
(when (part-tag d) (when (part-tag d)
(printf "\\label{section:~a}" (part-tag d))) (printf "\\label{section:~a}" (protect-tag (part-tag d))))
(render-flow (part-flow d) d ht) (render-flow (part-flow d) d ht)
(for-each (lambda (sec) (render-part sec ht)) (for-each (lambda (sec) (render-part sec ht))
(part-parts d)) (part-parts d))

View File

@ -374,7 +374,21 @@
dots1] dots1]
[(eq? v '...) [(eq? v '...)
dots0] dots0]
[else v]))]) [else v]))]
[prototype-size (lambda (s)
(let loop ([s s])
(if (null? s)
1
(+ 1 (loop (cdr s))
(cond
[(symbol? (car s)) (string-length (symbol->string (car s)))]
[(pair? (car s))
(if (keyword? (caar s))
(+ (string-length (keyword->string (caar s)))
3
(string-length (symbol->string (cadar s))))
(string-length (symbol->string (caar s))))]
[else 0])))))])
(parameterize ([current-variable-list (parameterize ([current-variable-list
(map (lambda (i) (map (lambda (i)
(and (pair? i) (and (pair? i)
@ -393,43 +407,98 @@
(append (append
(list (list
(list (make-flow (list (make-flow
(make-table-if-necessary (let-values ([(required optional more-required)
"prototype" (let loop ([a (cdr prototype)][r-accum null])
(list (if (or (null? a)
(list (and (has-optional? (car a))))
(to-flow (let ([req (reverse r-accum)])
(let-values ([(required optional more-required) (let loop ([a a][o-accum null])
(let loop ([a (cdr prototype)][r-accum null]) (if (or (null? a)
(if (or (null? a) (not (has-optional? (car a))))
(and (has-optional? (car a)))) (values req (reverse o-accum) a)
(let ([req (reverse r-accum)]) (loop (cdr a) (cons (car a) o-accum)))))
(let loop ([a a][o-accum null]) (loop (cdr a) (cons (car a) r-accum))))]
(if (or (null? a) [(tagged) (if first?
(not (has-optional? (car a)))) (make-target-element
(values req (reverse o-accum) a) #f
(loop (cdr a) (cons (car a) o-accum))))) (list (to-element (make-just-context (car prototype)
(loop (cdr a) (cons (car a) r-accum))))]) stx-id)))
(to-element (append (register-scheme-definition stx-id))
(list (if first? (to-element (make-just-context (car prototype)
(make-target-element stx-id)))]
#f [(short?) (or ((prototype-size prototype) . < . 40)
(list (to-element (car prototype))) ((length prototype) . < . 3))]
(register-scheme-definition stx-id)) [(end) (list (to-flow spacer)
(to-element (car prototype)))) (to-flow 'rarr)
(map arg->elem required) (to-flow spacer)
(if (null? optional) (make-flow (list (result-contract))))])
null (if short?
(list (make-table-if-necessary
(to-element "prototype"
(syntax-property (list
(syntax-ize (map arg->elem optional) 0) (cons
'paren-shape (to-flow
#\?)))) (to-element (append
(map arg->elem more-required))))) (list tagged)
(to-flow spacer) (map arg->elem required)
(to-flow 'rarr) (if (null? optional)
(to-flow spacer) null
(make-flow (list (result-contract))))))))) (list
(to-element
(syntax-property
(syntax-ize (map arg->elem optional) 0)
'paren-shape
#\?))))
(map arg->elem more-required))))
end)))
(let ([not-end
(list (to-flow spacer)
(to-flow spacer)
(to-flow spacer)
(to-flow spacer))])
(list
(make-table
"prototype"
(cons
(list* (to-flow (make-element
#f
(list
(schemeparenfont "(")
tagged)))
(cond
[(null? required)
(to-flow (make-element #f (list spacer "[")))]
[else
(to-flow spacer)])
(to-flow
(if (null? required)
(arg->elem (car optional))
(arg->elem (car required))))
not-end)
(let loop ([args (cdr (append required optional))]
[req (sub1 (length required))])
(if (null? args)
null
(cons (list* (to-flow spacer)
(if (zero? req)
(to-flow (make-element #f (list spacer "[")))
(to-flow spacer))
(let ([a (arg->elem (car args))])
(to-flow
(cond
[(null? (cdr args))
(if (null? optional)
(make-element
#f
(list a (schemeparenfont ")")))
(make-element
#f
(list a "]" (schemeparenfont ")"))))]
[else a])))
(if (null? (cdr args))
end
not-end))
(loop (cdr args) (sub1 req))))))))))))))
(apply append (apply append
(map (lambda (v arg-contract) (map (lambda (v arg-contract)
(cond (cond

View File

@ -154,6 +154,9 @@
.prototype td { .prototype td {
vertical-align: top; vertical-align: top;
} }
.longprototype td {
vertical-align: bottom;
}
.schemeblock td { .schemeblock td {
vertical-align: baseline; vertical-align: baseline;