continued work on the guide
svn: r6338 original commit: 5f37b5e912f099b1558b7a40ee950b3342a2dfa3
This commit is contained in:
Matthew Flatt
parent
1c865ed71d
commit
6612b39d5e
|
|
@ -278,7 +278,6 @@
|
|||
(append
|
||||
(format-number number
|
||||
(list
|
||||
"."
|
||||
(make-element 'hspace '(" "))))
|
||||
(part-title-content part))
|
||||
`(part ,(part-tag part))))))))
|
||||
|
|
|
|||
|
|
@ -122,19 +122,36 @@
|
|||
(with-handlers ([exn? (lambda (e)
|
||||
(exn-message e))])
|
||||
(cons (let ([v (do-plain-eval s #t)])
|
||||
(copy-value v))
|
||||
(copy-value v (make-hash-table)))
|
||||
(get-output-string o)))))]))
|
||||
|
||||
(define (install ht v v2)
|
||||
(hash-table-put! ht v v2)
|
||||
v2)
|
||||
|
||||
;; Since we evaluate everything in an interaction before we typeset,
|
||||
;; copy each value to avoid side-effects.
|
||||
(define (copy-value v)
|
||||
(define (copy-value v ht)
|
||||
(cond
|
||||
[(string? v) (string-copy v)]
|
||||
[(bytes? v) (bytes-copy v)]
|
||||
[(pair? v) (cons (copy-value (car v))
|
||||
(copy-value (cdr v)))]
|
||||
[(and v (hash-table-get ht v #f))
|
||||
=> (lambda (v) v)]
|
||||
[(string? v) (install ht v (string-copy v))]
|
||||
[(bytes? v) (install ht v (bytes-copy v))]
|
||||
[(pair? v) (let ([p (cons #f #f)])
|
||||
(hash-table-put! ht v p)
|
||||
(set-car! p (copy-value (car v) ht))
|
||||
(set-cdr! p (copy-value (cdr v) ht))
|
||||
p)]
|
||||
[(vector? v) (let ([v2 (make-vector (vector-length v))])
|
||||
(hash-table-put! ht v v2)
|
||||
(let loop ([i (vector-length v2)])
|
||||
(unless (zero? i)
|
||||
(let ([i (sub1 i)])
|
||||
(vector-set! v2 i (copy-value (vector-ref v i) ht))
|
||||
(loop i))))
|
||||
v2)]
|
||||
[else v]))
|
||||
|
||||
|
||||
(define (strip-comments s)
|
||||
(cond
|
||||
[(and (pair? s)
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@
|
|||
[(0) 'h2]
|
||||
[(1) 'h3]
|
||||
[else 'h4])
|
||||
,@(format-number number '("." (tt nbsp)))
|
||||
,@(format-number number '((tt nbsp)))
|
||||
,@(if (part-tag d)
|
||||
`((a ((name ,(format "~a" `(part ,(part-tag d)))))))
|
||||
null)
|
||||
|
|
@ -186,6 +186,7 @@
|
|||
[(boxed) '((width "100%") (bgcolor "lightgray"))]
|
||||
[(centered) '((align "center"))]
|
||||
[(at-right) '((align "right"))]
|
||||
[(at-left) '((align "left"))]
|
||||
[else null]))
|
||||
,@(map (lambda (flows)
|
||||
`(tr ,@(map (lambda (d a)
|
||||
|
|
@ -278,6 +279,8 @@
|
|||
ds
|
||||
fns))
|
||||
|
||||
(define contents-content '("contents"))
|
||||
(define index-content '("index"))
|
||||
(define prev-content '(larr " prev"))
|
||||
(define up-content '("up"))
|
||||
(define next-content '("next " rarr))
|
||||
|
|
@ -299,9 +302,12 @@
|
|||
(and (pair? (cdr l))
|
||||
(cadr l)))]
|
||||
[else (loop (cdr l) (car l))]))))
|
||||
|
||||
(define/private (part-parent d)
|
||||
(collected-info-parent (part-collected-info d)))
|
||||
|
||||
(define/private (navigation d ht)
|
||||
(let ([parent (collected-info-parent (part-collected-info d))])
|
||||
(let ([parent (part-parent d)])
|
||||
(let*-values ([(prev next) (find-siblings d)]
|
||||
[(prev) (if prev
|
||||
(let loop ([prev prev])
|
||||
|
|
@ -322,39 +328,78 @@
|
|||
(let-values ([(prev next)
|
||||
(find-siblings parent)])
|
||||
next)]
|
||||
[else next])])
|
||||
(render-table (make-table
|
||||
'at-right
|
||||
(list
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
(if parent
|
||||
[else next])]
|
||||
[(index) (let loop ([d d])
|
||||
(let ([p (part-parent d)])
|
||||
(if p
|
||||
(loop p)
|
||||
(let ([subs (part-parts d)])
|
||||
(and (pair? subs)
|
||||
(let ([d (car (last-pair subs))])
|
||||
(and (equal? '("Index") (part-title-content d))
|
||||
d)))))))])
|
||||
`(,@(render-table (make-table
|
||||
'at-left
|
||||
(list
|
||||
(cons
|
||||
(make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
(make-element
|
||||
(make-target-url (if prev
|
||||
(derive-filename prev)
|
||||
"index.html"))
|
||||
(if parent
|
||||
(make-target-url "index.html")
|
||||
"nonavigation")
|
||||
contents-content)))))
|
||||
(if index
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
'nbsp
|
||||
(if (eq? d index)
|
||||
(make-element
|
||||
"nonavigation"
|
||||
index-content)
|
||||
(make-link-element
|
||||
#f
|
||||
index-content
|
||||
`(part ,(part-tag index)))))))))
|
||||
null))))
|
||||
d ht)
|
||||
,@(render-table (make-table
|
||||
'at-right
|
||||
(list
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
(make-element
|
||||
(if parent
|
||||
(make-target-url (if prev
|
||||
(derive-filename prev)
|
||||
"index.html"))
|
||||
"nonavigation")
|
||||
prev-content)
|
||||
"")
|
||||
sep-element
|
||||
(if parent
|
||||
sep-element
|
||||
(make-element
|
||||
(make-target-url
|
||||
(if (toc-part? parent)
|
||||
(derive-filename parent)
|
||||
"index.html"))
|
||||
(if parent
|
||||
(make-target-url
|
||||
(if (toc-part? parent)
|
||||
(derive-filename parent)
|
||||
"index.html"))
|
||||
"nonavigation")
|
||||
up-content)
|
||||
"")
|
||||
sep-element
|
||||
(make-element
|
||||
(if next
|
||||
(make-target-url (derive-filename next))
|
||||
"nonavigation")
|
||||
next-content))))))))
|
||||
d
|
||||
ht))))
|
||||
sep-element
|
||||
(make-element
|
||||
(if next
|
||||
(make-target-url (derive-filename next))
|
||||
"nonavigation")
|
||||
next-content))))))))
|
||||
d
|
||||
ht)))))
|
||||
|
||||
(define/override (render-part d ht)
|
||||
(let ([number (collected-info-number (part-collected-info d))])
|
||||
|
|
|
|||
|
|
@ -200,15 +200,21 @@
|
|||
(convert-infix c quote-depth))
|
||||
=> (lambda (converted)
|
||||
((loop init-line! quote-depth) converted))]
|
||||
[(pair? (syntax-e c))
|
||||
[(or (pair? (syntax-e c))
|
||||
(vector? (syntax-e c)))
|
||||
(let* ([sh (or (syntax-property c 'paren-shape)
|
||||
#\()]
|
||||
[quote-depth (if (vector? (syntax-e c))
|
||||
+inf.0
|
||||
quote-depth)]
|
||||
[p-color (if (positive? quote-depth)
|
||||
value-color
|
||||
(if (eq? sh #\?)
|
||||
opt-color
|
||||
paren-color))])
|
||||
(advance c init-line!)
|
||||
(when (vector? (syntax-e c))
|
||||
(out (format "#~a" (vector-length (syntax-e c))) p-color))
|
||||
(out (case sh
|
||||
[(#\[ #\?) "["]
|
||||
[(#\{) "{"]
|
||||
|
|
@ -216,7 +222,9 @@
|
|||
p-color)
|
||||
(set! src-col (+ src-col 1))
|
||||
(hash-table-put! col-map src-col dest-col)
|
||||
(let lloop ([l c])
|
||||
(let lloop ([l (if (vector? (syntax-e c))
|
||||
(vector->short-list (syntax-e c) syntax-e)
|
||||
c)])
|
||||
(cond
|
||||
[(and (syntax? l)
|
||||
(pair? (syntax-e l)))
|
||||
|
|
@ -357,6 +365,29 @@
|
|||
|
||||
(define syntax-ize-hook (make-parameter (lambda (v col) #f)))
|
||||
|
||||
(define (vector->short-list v extract)
|
||||
(let ([l (vector->list v)])
|
||||
(reverse (list-tail
|
||||
(reverse l)
|
||||
(- (vector-length v)
|
||||
(let loop ([i (sub1 (vector-length v))])
|
||||
(cond
|
||||
[(zero? i) 1]
|
||||
[(eq? (extract (vector-ref v i))
|
||||
(extract (vector-ref v (sub1 i))))
|
||||
(loop (sub1 i))]
|
||||
[else (add1 i)])))))))
|
||||
|
||||
(define (short-list->vector v l)
|
||||
(list->vector
|
||||
(let ([n (length l)])
|
||||
(if (n . < . (vector-length v))
|
||||
(reverse (let loop ([r (reverse l)][i (- (vector-length v) n)])
|
||||
(if (zero? i)
|
||||
r
|
||||
(loop (cons (car r) r) (sub1 i)))))
|
||||
l))))
|
||||
|
||||
(define (syntax-ize v col)
|
||||
(cond
|
||||
[((syntax-ize-hook) v col)
|
||||
|
|
@ -370,20 +401,29 @@
|
|||
c)
|
||||
(list #f 1 col (+ 1 col)
|
||||
(+ 1 (syntax-span c)))))]
|
||||
[(list? v)
|
||||
(let ([l (let loop ([col (+ col 1)]
|
||||
[v v])
|
||||
(if (null? v)
|
||||
null
|
||||
(let ([i (syntax-ize (car v) col)])
|
||||
(cons i
|
||||
(loop (+ col 1 (syntax-span i)) (cdr v))))))])
|
||||
(datum->syntax-object #f
|
||||
l
|
||||
(list #f 1 col (+ 1 col)
|
||||
(+ 2
|
||||
(sub1 (length l))
|
||||
(apply + (map syntax-span l))))))]
|
||||
[(or (list? v)
|
||||
(vector? v))
|
||||
(let* ([vec-sz (if (vector? v)
|
||||
(+ 1 (string-length (format "~a" (vector-length v))))
|
||||
0)])
|
||||
(let ([l (let loop ([col (+ col 1 vec-sz)]
|
||||
[v (if (vector? v)
|
||||
(vector->short-list v values)
|
||||
v)])
|
||||
(if (null? v)
|
||||
null
|
||||
(let ([i (syntax-ize (car v) col)])
|
||||
(cons i
|
||||
(loop (+ col 1 (syntax-span i)) (cdr v))))))])
|
||||
(datum->syntax-object #f
|
||||
(if (vector? v)
|
||||
(short-list->vector v l)
|
||||
l)
|
||||
(list #f 1 col (+ 1 col)
|
||||
(+ 2
|
||||
vec-sz
|
||||
(sub1 (length l))
|
||||
(apply + (map syntax-span l)))))))]
|
||||
[(pair? v)
|
||||
(let* ([a (syntax-ize (car v) (+ col 1))]
|
||||
[sep (if (pair? (cdr v)) 0 3)]
|
||||
|
|
|
|||
|
|
@ -219,7 +219,7 @@
|
|||
}
|
||||
|
||||
.nonavigation {
|
||||
color: gray;
|
||||
color: #EEEEEE;
|
||||
}
|
||||
|
||||
.disable {
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user