diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index f454eeb8..54d047d9 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -279,7 +279,7 @@
(content->string (part-title-content d)
this d ht))
"_"))])
- (when ((string-length fn) . >= . 100)
+ (when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn))
diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss
index 00e7a594..af317dbd 100644
--- a/collects/scribble/latex-render.ss
+++ b/collects/scribble/latex-render.ss
@@ -87,8 +87,9 @@
""))
(render-content (part-title-content d) d ht)
(printf "}"))
+ #;
(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)
(for-each (lambda (sec) (render-part sec ht))
(part-parts d))
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index bf95ec17..b39e6a5c 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -374,7 +374,21 @@
dots1]
[(eq? v '...)
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
(map (lambda (i)
(and (pair? i)
@@ -393,43 +407,98 @@
(append
(list
(list (make-flow
- (make-table-if-necessary
- "prototype"
- (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 stx-id))
- (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)))))))))
+ (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))))]
+ [(tagged) (if first?
+ (make-target-element
+ #f
+ (list (to-element (make-just-context (car prototype)
+ stx-id)))
+ (register-scheme-definition stx-id))
+ (to-element (make-just-context (car prototype)
+ stx-id)))]
+ [(short?) (or ((prototype-size prototype) . < . 40)
+ ((length prototype) . < . 3))]
+ [(end) (list (to-flow spacer)
+ (to-flow 'rarr)
+ (to-flow spacer)
+ (make-flow (list (result-contract))))])
+ (if short?
+ (make-table-if-necessary
+ "prototype"
+ (list
+ (cons
+ (to-flow
+ (to-element (append
+ (list tagged)
+ (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))))
+ 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
(map (lambda (v arg-contract)
(cond
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
index 77e65b95..1e841947 100644
--- a/collects/scribble/scribble.css
+++ b/collects/scribble/scribble.css
@@ -154,6 +154,9 @@
.prototype td {
vertical-align: top;
}
+ .longprototype td {
+ vertical-align: bottom;
+ }
.schemeblock td {
vertical-align: baseline;