commit f6bf8a082944e1b2bd7897a8d1e263cfa1ad7e17
parent 564b5eb934d98bd30b27650814f970d3d4ab8300
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 2 Jul 2007 02:02:10 +0000
doc work, especially threads and continuations reference
svn: r6786
original commit: 560eb6721725c0353ebd383d519d6c3eb60fd3de
Diffstat:
2 files changed, 98 insertions(+), 46 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -274,17 +274,20 @@
;; ----------------------------------------
(define/public (table-of-contents part ht)
- (make-table #f (render-toc part #t)))
+ (make-table #f (render-toc part
+ (sub1 (length (collected-info-number
+ (part-collected-info part))))
+ #t)))
(define/public (local-table-of-contents part ht)
(table-of-contents part ht))
- (define/private (render-toc part skip?)
+ (define/private (render-toc part base-len skip?)
(let ([number (collected-info-number (part-collected-info part))])
(let ([subs
(apply
append
- (map (lambda (p) (render-toc p #f)) (part-parts part)))])
+ (map (lambda (p) (render-toc p base-len #f)) (part-parts part)))])
(if skip?
subs
(let ([l (cons
@@ -292,7 +295,7 @@
(list
(make-paragraph
(list
- (make-element 'hspace (list (make-string (* 2 (length number)) #\space)))
+ (make-element 'hspace (list (make-string (* 2 (- (length number) base-len)) #\space)))
(make-link-element (if (= 1 (length number))
"toptoclink"
"toclink")
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -378,6 +378,8 @@
(list (make-table style content))))
(list (make-table style content))))
+ (define max-proto-width 65)
+
(define (*defproc stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)]
[has-optional? (lambda (arg)
@@ -437,7 +439,12 @@
(let ([req (reverse r-accum)])
(let loop ([a a][o-accum null])
(if (or (null? a)
- (not (has-optional? (car a))))
+ (and (not (has-optional? (car a)))
+ ;; A repeat after an optional argument is
+ ;; effectively optional:
+ (not (memq (car a) '(...)))
+ (or (null? (cdr a))
+ (not (memq (cadr a) '(...))))))
(values req (reverse o-accum) a)
(loop (cdr a) (cons (car a) o-accum)))))
(loop (cdr a) (cons (car a) r-accum))))]
@@ -457,11 +464,12 @@
flat-size
(prototype-size prototype + max))
(flow-element-width res))
- . >= . 50)]
+ . >= . (- max-proto-width 7))]
[(end) (list (to-flow spacer)
(to-flow 'rarr)
(to-flow spacer)
- (make-flow (list res)))])
+ (make-flow (list res)))]
+ [(opt-cnt) (length optional)])
(append
(list
(list (make-flow
@@ -512,31 +520,44 @@
(arg->elem (car optional))
(arg->elem (car required))))
not-end)
- (let loop ([args (cdr (append required optional))]
+ (let loop ([args (cdr (append required optional more-required))]
[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 (and (null? (cdr args))
- (not result-next-line?))
- end
- not-end))
- (loop (cdr args) (sub1 req)))))))))))))
+ (let ([dots-next? (or (and (pair? (cdr args))
+ (or (eq? (cadr args) '...)
+ (eq? (cadr args) '...+))))])
+ (cons (list* (to-flow spacer)
+ (if (zero? req)
+ (to-flow (make-element #f (list spacer "[")))
+ (to-flow spacer))
+ (let ([a (arg->elem (car args))]
+ [next (if dots-next?
+ (make-element #f (list (hspace 1)
+ (arg->elem (cadr args))))
+ "")])
+ (to-flow
+ (cond
+ [(null? ((if dots-next? cddr cdr) args))
+ (if (or (null? optional)
+ (not (null? more-required)))
+ (make-element
+ #f
+ (list a next (schemeparenfont ")")))
+ (make-element
+ #f
+ (list a next "]" (schemeparenfont ")"))))]
+ [(and (pair? more-required)
+ (= (- 1 req) (length optional)))
+ (make-element #f (list a next "]"))]
+ [(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) (sub1 req))))))))))))))
(if result-next-line?
(list (list (make-flow (make-table-if-necessary
"prototype"
@@ -546,29 +567,52 @@
(map (lambda (v arg-contract)
(cond
[(pair? v)
- (list
- (list
- (make-flow
- (make-table-if-necessary
- "argcontract"
- (list
- (let ([v (if (keyword? (car v))
- (cdr v)
- v)])
- (append
+ (let* ([v (if (keyword? (car v))
+ (cdr v)
+ v)]
+ [arg-cont (arg-contract)]
+ [base-len (+ 5 (string-length (symbol->string (car v)))
+ (flow-element-width arg-cont))]
+ [def-len (if (has-optional? v)
+ (string-length (format "~a" (caddr v)))
+ 0)]
+ [base-list
(list
(to-flow (hspace 2))
(to-flow (arg->elem v))
(to-flow spacer)
(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))))))))]
+ (make-flow (list arg-cont)))])
+ (list
+ (list
+ (make-flow
+ (if (and (has-optional? v)
+ ((+ base-len 3 def-len) . >= . max-proto-width))
+ (list
+ (make-table
+ "argcontract"
+ (list
+ base-list
+ (list
+ (to-flow spacer)
+ (to-flow spacer)
+ (to-flow spacer)
+ (to-flow "=")
+ (to-flow spacer)
+ (to-flow (to-element (caddr v)))))))
+ (make-table-if-necessary
+ "argcontract"
+ (list
+ (append
+ base-list
+ (if (and (has-optional? v)
+ ((+ base-len 3 def-len) . < . max-proto-width))
+ (list (to-flow spacer)
+ (to-flow "=")
+ (to-flow spacer)
+ (to-flow (to-element (caddr v))))
+ null)))))))))]
[else null]))
(cdr prototype)
arg-contracts)))))
@@ -815,6 +859,11 @@
(define (commandline . s)
(make-paragraph (list (hspace 2) (apply tt s))))
+ (define (elemtag t . body)
+ (make-target-element #f (decode-content body) t))
+ (define (elemref t . body)
+ (make-link-element #f (decode-content body) t))
+ (provide elemtag elemref)
(define (secref s)
(make-link-element #f null `(part ,s)))
