suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scribble/html-render.ss
View File

@ -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))

3
collects/scribble/latex-render.ss
View File

@ -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))

97
collects/scribble/manual.ss
View File

@ -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,11 +407,6 @@
(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)
@ -408,14 +417,29 @@
(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?
(loop (cdr a) (cons (car a) r-accum))))]
[(tagged) (if first?
(make-target-element
#f
(list (to-element (car prototype)))
(list (to-element (make-just-context (car prototype)
stx-id)))
(register-scheme-definition stx-id))
(to-element (car prototype))))
(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
@ -425,11 +449,56 @@
(syntax-ize (map arg->elem optional) 0)
'paren-shape
#\?))))
(map arg->elem more-required)))))
(map arg->elem more-required))))
end)))
(let ([not-end
(list (to-flow spacer)
(to-flow spacer)
(to-flow 'rarr)
(to-flow spacer)
(make-flow (list (result-contract)))))))))
(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

3
collects/scribble/scribble.css
View File

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