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

doc work, especially threads and continuations reference

Browse Source 
svn: r6786

original commit: 560eb6721725c0353ebd383d519d6c3eb60fd3de
This commit is contained in:
Matthew Flatt 2007-07-02 02:02:10 +00:00
parent 564b5eb934
commit f6bf8a0829
2 changed files with 98 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/scribble/base-render.ss
View File

@ -274,17 +274,20 @@
;; ---------------------------------------- ;; ----------------------------------------
(define/public (table-of-contents part ht) (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) (define/public (local-table-of-contents part ht)
(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 ([number (collected-info-number (part-collected-info part))])
(let ([subs (let ([subs
(apply (apply
append 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? (if skip?
subs subs
(let ([l (cons (let ([l (cons
@ -292,7 +295,7 @@
(list (list
(make-paragraph (make-paragraph
(list (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)) (make-link-element (if (= 1 (length number))
"toptoclink" "toptoclink"
"toclink") "toclink")

133
collects/scribble/manual.ss
View File

@ -378,6 +378,8 @@
(list (make-table style content)))) (list (make-table style content))))
(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) (define (*defproc stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)] (let ([spacer (hspace 1)]
[has-optional? (lambda (arg) [has-optional? (lambda (arg)
@ -437,7 +439,12 @@
(let ([req (reverse r-accum)]) (let ([req (reverse r-accum)])
(let loop ([a a][o-accum null]) (let loop ([a a][o-accum null])
(if (or (null? a) (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) (values req (reverse o-accum) a)
(loop (cdr a) (cons (car a) o-accum))))) (loop (cdr a) (cons (car a) o-accum)))))
(loop (cdr a) (cons (car a) r-accum))))] (loop (cdr a) (cons (car a) r-accum))))]
@ -457,11 +464,12 @@
flat-size flat-size
(prototype-size prototype + max)) (prototype-size prototype + max))
(flow-element-width res)) (flow-element-width res))
. >= . 50)] . >= . (- max-proto-width 7))]
[(end) (list (to-flow spacer) [(end) (list (to-flow spacer)
(to-flow 'rarr) (to-flow 'rarr)
(to-flow spacer) (to-flow spacer)
(make-flow (list res)))]) (make-flow (list res)))]
[(opt-cnt) (length optional)])
(append (append
(list (list
(list (make-flow (list (make-flow
@ -512,31 +520,44 @@
(arg->elem (car optional)) (arg->elem (car optional))
(arg->elem (car required)))) (arg->elem (car required))))
not-end) not-end)
(let loop ([args (cdr (append required optional))] (let loop ([args (cdr (append required optional more-required))]
[req (sub1 (length required))]) [req (sub1 (length required))])
(if (null? args) (if (null? args)
null null
(cons (list* (to-flow spacer) (let ([dots-next? (or (and (pair? (cdr args))
(if (zero? req) (or (eq? (cadr args) '...)
(to-flow (make-element #f (list spacer "["))) (eq? (cadr args) '...+))))])
(to-flow spacer)) (cons (list* (to-flow spacer)
(let ([a (arg->elem (car args))]) (if (zero? req)
(to-flow (to-flow (make-element #f (list spacer "[")))
(cond (to-flow spacer))
[(null? (cdr args)) (let ([a (arg->elem (car args))]
(if (null? optional) [next (if dots-next?
(make-element (make-element #f (list (hspace 1)
#f (arg->elem (cadr args))))
(list a (schemeparenfont ")"))) "")])
(make-element (to-flow
#f (cond
(list a "]" (schemeparenfont ")"))))] [(null? ((if dots-next? cddr cdr) args))
[else a]))) (if (or (null? optional)
(if (and (null? (cdr args)) (not (null? more-required)))
(not result-next-line?)) (make-element
end #f
not-end)) (list a next (schemeparenfont ")")))
(loop (cdr args) (sub1 req))))))))))))) (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? (if result-next-line?
(list (list (make-flow (make-table-if-necessary (list (list (make-flow (make-table-if-necessary
"prototype" "prototype"
@ -546,29 +567,52 @@
(map (lambda (v arg-contract) (map (lambda (v arg-contract)
(cond (cond
[(pair? v) [(pair? v)
(list (let* ([v (if (keyword? (car v))
(list (cdr v)
(make-flow v)]
(make-table-if-necessary [arg-cont (arg-contract)]
"argcontract" [base-len (+ 5 (string-length (symbol->string (car v)))
(list (flow-element-width arg-cont))]
(let ([v (if (keyword? (car v)) [def-len (if (has-optional? v)
(cdr v) (string-length (format "~a" (caddr v)))
v)]) 0)]
(append [base-list
(list (list
(to-flow (hspace 2)) (to-flow (hspace 2))
(to-flow (arg->elem v)) (to-flow (arg->elem v))
(to-flow spacer) (to-flow spacer)
(to-flow ":") (to-flow ":")
(to-flow spacer) (to-flow spacer)
(make-flow (list (arg-contract)))) (make-flow (list arg-cont)))])
(if (has-optional? v) (list
(list (to-flow spacer) (list
(to-flow "=") (make-flow
(to-flow spacer) (if (and (has-optional? v)
(to-flow (to-element (caddr v)))) ((+ base-len 3 def-len) . >= . max-proto-width))
null))))))))] (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])) [else null]))
(cdr prototype) (cdr prototype)
arg-contracts))))) arg-contracts)))))
@ -815,6 +859,11 @@
(define (commandline . s) (define (commandline . s)
(make-paragraph (list (hspace 2) (apply tt 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) (define (secref s)
(make-link-element #f null `(part ,s))) (make-link-element #f null `(part ,s)))