suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

continued work on the guide

Browse Source 
svn: r6338

original commit: 5f37b5e912f099b1558b7a40ee950b3342a2dfa3
This commit is contained in:
Matthew Flatt 2007-05-26 06:31:34 +00:00
parent 1c865ed71d
commit 6612b39d5e
5 changed files with 157 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -278,7 +278,6 @@
(append (append
(format-number number (format-number number
(list (list
"."
(make-element 'hspace '(" ")))) (make-element 'hspace '(" "))))
(part-title-content part)) (part-title-content part))
`(part ,(part-tag part)))))))) `(part ,(part-tag part))))))))

31
collects/scribble/eval.ss
View File

@ -122,19 +122,36 @@
(with-handlers ([exn? (lambda (e) (with-handlers ([exn? (lambda (e)
(exn-message e))]) (exn-message e))])
(cons (let ([v (do-plain-eval s #t)]) (cons (let ([v (do-plain-eval s #t)])
(copy-value v)) (copy-value v (make-hash-table)))
(get-output-string o)))))])) (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, ;; Since we evaluate everything in an interaction before we typeset,
;; copy each value to avoid side-effects. ;; copy each value to avoid side-effects.
(define (copy-value v) (define (copy-value v ht)
(cond (cond
[(string? v) (string-copy v)] [(and v (hash-table-get ht v #f))
[(bytes? v) (bytes-copy v)] => (lambda (v) v)]
[(pair? v) (cons (copy-value (car v)) [(string? v) (install ht v (string-copy v))]
(copy-value (cdr 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])) [else v]))
(define (strip-comments s) (define (strip-comments s)
(cond (cond
[(and (pair? s) [(and (pair? s)

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

@ -92,7 +92,7 @@
[(0) 'h2] [(0) 'h2]
[(1) 'h3] [(1) 'h3]
[else 'h4]) [else 'h4])
,@(format-number number '("." (tt nbsp))) ,@(format-number number '((tt nbsp)))
,@(if (part-tag d) ,@(if (part-tag d)
`((a ((name ,(format "~a" `(part ,(part-tag d))))))) `((a ((name ,(format "~a" `(part ,(part-tag d)))))))
null) null)
@ -186,6 +186,7 @@
[(boxed) '((width "100%") (bgcolor "lightgray"))] [(boxed) '((width "100%") (bgcolor "lightgray"))]
[(centered) '((align "center"))] [(centered) '((align "center"))]
[(at-right) '((align "right"))] [(at-right) '((align "right"))]
[(at-left) '((align "left"))]
[else null])) [else null]))
,@(map (lambda (flows) ,@(map (lambda (flows)
`(tr ,@(map (lambda (d a) `(tr ,@(map (lambda (d a)
@ -278,6 +279,8 @@
ds ds
fns)) fns))
(define contents-content '("contents"))
(define index-content '("index"))
(define prev-content '(larr " prev")) (define prev-content '(larr " prev"))
(define up-content '("up")) (define up-content '("up"))
(define next-content '("next " rarr)) (define next-content '("next " rarr))
@ -299,9 +302,12 @@
(and (pair? (cdr l)) (and (pair? (cdr l))
(cadr l)))] (cadr l)))]
[else (loop (cdr l) (car l))])))) [else (loop (cdr l) (car l))]))))
(define/private (part-parent d)
(collected-info-parent (part-collected-info d)))
(define/private (navigation d ht) (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)] (let*-values ([(prev next) (find-siblings d)]
[(prev) (if prev [(prev) (if prev
(let loop ([prev prev]) (let loop ([prev prev])
@ -322,39 +328,78 @@
(let-values ([(prev next) (let-values ([(prev next)
(find-siblings parent)]) (find-siblings parent)])
next)] next)]
[else next])]) [else next])]
(render-table (make-table [(index) (let loop ([d d])
'at-right (let ([p (part-parent d)])
(list (if p
(list (loop p)
(make-flow (let ([subs (part-parts d)])
(list (and (pair? subs)
(make-paragraph (let ([d (car (last-pair subs))])
(list (and (equal? '("Index") (part-title-content d))
(if parent d)))))))])
`(,@(render-table (make-table
'at-left
(list
(cons
(make-flow
(list
(make-paragraph
(list
(make-element (make-element
(make-target-url (if prev (if parent
(derive-filename prev) (make-target-url "index.html")
"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) prev-content)
"") sep-element
sep-element
(if parent
(make-element (make-element
(make-target-url (if parent
(if (toc-part? parent) (make-target-url
(derive-filename parent) (if (toc-part? parent)
"index.html")) (derive-filename parent)
"index.html"))
"nonavigation")
up-content) up-content)
"") sep-element
sep-element (make-element
(make-element (if next
(if next (make-target-url (derive-filename next))
(make-target-url (derive-filename next)) "nonavigation")
"nonavigation") next-content))))))))
next-content)))))))) d
d ht)))))
ht))))
(define/override (render-part d ht) (define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d))]) (let ([number (collected-info-number (part-collected-info d))])

72
collects/scribble/scheme.ss
View File

@ -200,15 +200,21 @@
(convert-infix c quote-depth)) (convert-infix c quote-depth))
=> (lambda (converted) => (lambda (converted)
((loop init-line! quote-depth) 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) (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) [p-color (if (positive? quote-depth)
value-color value-color
(if (eq? sh #\?) (if (eq? sh #\?)
opt-color opt-color
paren-color))]) paren-color))])
(advance c init-line!) (advance c init-line!)
(when (vector? (syntax-e c))
(out (format "#~a" (vector-length (syntax-e c))) p-color))
(out (case sh (out (case sh
[(#\[ #\?) "["] [(#\[ #\?) "["]
[(#\{) "{"] [(#\{) "{"]
@ -216,7 +222,9 @@
p-color) p-color)
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
(hash-table-put! col-map src-col dest-col) (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 (cond
[(and (syntax? l) [(and (syntax? l)
(pair? (syntax-e l))) (pair? (syntax-e l)))
@ -357,6 +365,29 @@
(define syntax-ize-hook (make-parameter (lambda (v col) #f))) (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) (define (syntax-ize v col)
(cond (cond
[((syntax-ize-hook) v col) [((syntax-ize-hook) v col)
@ -370,20 +401,29 @@
c) c)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 1 (syntax-span c)))))] (+ 1 (syntax-span c)))))]
[(list? v) [(or (list? v)
(let ([l (let loop ([col (+ col 1)] (vector? v))
[v v]) (let* ([vec-sz (if (vector? v)
(if (null? v) (+ 1 (string-length (format "~a" (vector-length v))))
null 0)])
(let ([i (syntax-ize (car v) col)]) (let ([l (let loop ([col (+ col 1 vec-sz)]
(cons i [v (if (vector? v)
(loop (+ col 1 (syntax-span i)) (cdr v))))))]) (vector->short-list v values)
(datum->syntax-object #f v)])
l (if (null? v)
(list #f 1 col (+ 1 col) null
(+ 2 (let ([i (syntax-ize (car v) col)])
(sub1 (length l)) (cons i
(apply + (map syntax-span l))))))] (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) [(pair? v)
(let* ([a (syntax-ize (car v) (+ col 1))] (let* ([a (syntax-ize (car v) (+ col 1))]
[sep (if (pair? (cdr v)) 0 3)] [sep (if (pair? (cdr v)) 0 3)]

2
collects/scribble/scribble.css
View File

@ -219,7 +219,7 @@
} }
.nonavigation { .nonavigation {
color: gray; color: #EEEEEE;
} }
.disable { .disable {