commit 7733977558007aa18adaaec82428737f7aafcf0d
parent a2ebeaa1bba0b292584d286509caa17240c54919
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 28 Jun 2007 22:59:06 +0000
fix problem with recursive reads on hash tables, sfix syntax-quoted hash tables in marhsaled compiled code, and add a bit more new documentation
svn: r6759
original commit: b883f4ef765c783d4a013b76ebdbb2f6b7a8acd0
Diffstat:
4 files changed, 70 insertions(+), 58 deletions(-)
diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss
@@ -33,6 +33,31 @@
(define maxlen 60)
+ (define (format-output str style)
+ (if (string=? "" str)
+ null
+ (list
+ (list
+ (make-flow
+ (list
+ (let ([s (regexp-split #rx"\n"
+ (regexp-replace #rx"\n$"
+ str
+ ""))])
+ (if (= 1 (length s))
+ (make-paragraph
+ (list
+ (hspace 2)
+ (span-class style (car s))))
+ (make-table
+ #f
+ (map (lambda (s)
+ (list (make-flow (list (make-paragraph
+ (list
+ (hspace 2)
+ (span-class style s)))))))
+ s))))))))))
+
(define (interleave title expr-paras val-list+outputs)
(make-table
#f
@@ -48,29 +73,8 @@
(if (flow? p)
p
(make-flow (list p))))))
- (if (string=? "" (cdar val-list+outputs))
- null
- (list
- (list
- (make-flow
- (list
- (let ([s (regexp-split #rx"\n"
- (regexp-replace #rx"\n$"
- (cdar val-list+outputs)
- ""))])
- (if (= 1 (length s))
- (make-paragraph
- (list
- (hspace 2)
- (span-class "schemestdout" (car s))))
- (make-table
- #f
- (map (lambda (s)
- (list (make-flow (list (make-paragraph
- (list
- (hspace 2)
- (span-class "schemestdout" s)))))))
- s)))))))))
+ (format-output (cadar val-list+outputs) "schemestdout")
+ (format-output (caddar val-list+outputs) "schemeerror")
(if (string? (caar val-list+outputs))
;; Error result case:
(map
@@ -114,14 +118,18 @@
[(eval:alts p e)
(do-eval #'e)]
[else
- (let ([o (open-output-string)])
- (parameterize ([current-output-port o])
+ (let ([o (open-output-string)]
+ [o2 (open-output-string)])
+ (parameterize ([current-output-port o]
+ [current-error-port o2])
(with-handlers ([exn? (lambda (e)
- (cons (exn-message e)
- (get-output-string o)))])
- (cons (let ([v (do-plain-eval s #t)])
+ (list (exn-message e)
+ (get-output-string o)
+ (get-output-string o2)))])
+ (list (let ([v (do-plain-eval s #t)])
(copy-value v (make-hash-table)))
- (get-output-string o)))))]))
+ (get-output-string o)
+ (get-output-string o2)))))]))
(define (install ht v v2)
(hash-table-put! ht v v2)
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -77,27 +77,29 @@
(class "tocviewlink"))
,@(render-content (part-title-content top) d ht)))
(div nbsp)
- (div
- ((class "tocviewlist"))
+ (table
+ ((class "tocviewlist")
+ (cellspacing "0"))
,@(map (lambda (p)
- `(div
- ((class "tocviewitem"))
- (a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
- (format "~a~a~a"
- (from-root (car dest)
- (get-dest-directory))
- (if (caddr dest)
- ""
- "#")
- (if (caddr dest)
- ""
- `(part ,(part-tag p))))))
- (class ,(if (eq? p mine)
- "tocviewselflink"
- "tocviewlink")))
- ,@(format-number (collected-info-number (part-collected-info p))
- '((tt nbsp)))
- ,@(render-content (part-title-content p) d ht))))
+ `(tr
+ (td
+ ,@(format-number (collected-info-number (part-collected-info p))
+ '((tt nbsp))))
+ (td
+ (a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
+ (format "~a~a~a"
+ (from-root (car dest)
+ (get-dest-directory))
+ (if (caddr dest)
+ ""
+ "#")
+ (if (caddr dest)
+ ""
+ `(part ,(part-tag p))))))
+ (class ,(if (eq? p mine)
+ "tocviewselflink"
+ "tocviewlink")))
+ ,@(render-content (part-title-content p) d ht)))))
(part-parts top)))))))
(define/public (render-one-part d ht fn number)
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
@@ -338,11 +338,14 @@
"#hash"
"#hasheq")
value-color)
- (set! src-col (+ src-col 5 (if equal-table? 2 0)))
- (hash-table-put! next-col-map src-col dest-col)
- ((loop init-line! +inf.0)
- (syntax-ize (hash-table-map (syntax-e c) cons)
- (syntax-column c))))]
+ (let ([delta (+ 5 (if equal-table? 2 0))]
+ [orig-col src-col])
+ (set! src-col (+ src-col delta))
+ (hash-table-put! next-col-map src-col dest-col)
+ ((loop init-line! +inf.0)
+ (syntax-ize (hash-table-map (syntax-e c) cons)
+ (+ (syntax-column c) delta)))
+ (set! src-col (+ orig-col (syntax-span c)))))]
[else
(advance c init-line!)
(let-values ([(s it? sub?)
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
@@ -51,13 +51,12 @@
}
.tocviewlist {
- font-size: 80%;
margin: 0.2em 0.2em 0.2em 0.2em;
}
- .tocviewitem {
- margin-left: 1em;
- text-indent: -1em;
+ .tocviewlist td {
+ font-size: 80%;
+ vertical-align: top;
}
.tocviewlink {
