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

fix problem with recursive reads on hash tables, sfix syntax-quoted hash tables in marhsaled compiled code, and add a bit more new documentation

Browse Source 
svn: r6759

original commit: b883f4ef765c783d4a013b76ebdbb2f6b7a8acd0
This commit is contained in:
Matthew Flatt 2007-06-28 22:59:06 +00:00
parent a2ebeaa1bb
commit 7733977558
4 changed files with 70 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
collects/scribble/eval.ss
View File

@ -33,6 +33,31 @@
(define maxlen 60) (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) (define (interleave title expr-paras val-list+outputs)
(make-table (make-table
#f #f
@ -48,29 +73,8 @@
(if (flow? p) (if (flow? p)
p p
(make-flow (list p)))))) (make-flow (list p))))))
(if (string=? "" (cdar val-list+outputs)) (format-output (cadar val-list+outputs) "schemestdout")
null (format-output (caddar val-list+outputs) "schemeerror")
(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)))))))))
(if (string? (caar val-list+outputs)) (if (string? (caar val-list+outputs))
;; Error result case: ;; Error result case:
(map (map
@ -114,14 +118,18 @@
[(eval:alts p e) [(eval:alts p e)
(do-eval #'e)] (do-eval #'e)]
[else [else
(let ([o (open-output-string)]) (let ([o (open-output-string)]
(parameterize ([current-output-port o]) [o2 (open-output-string)])
(parameterize ([current-output-port o]
[current-error-port o2])
(with-handlers ([exn? (lambda (e) (with-handlers ([exn? (lambda (e)
(cons (exn-message e) (list (exn-message e)
(get-output-string o)))]) (get-output-string o)
(cons (let ([v (do-plain-eval s #t)]) (get-output-string o2)))])
(list (let ([v (do-plain-eval s #t)])
(copy-value v (make-hash-table))) (copy-value v (make-hash-table)))
(get-output-string o)))))])) (get-output-string o)
(get-output-string o2)))))]))
(define (install ht v v2) (define (install ht v v2)
(hash-table-put! ht v v2) (hash-table-put! ht v v2)

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

@ -77,27 +77,29 @@
(class "tocviewlink")) (class "tocviewlink"))
,@(render-content (part-title-content top) d ht))) ,@(render-content (part-title-content top) d ht)))
(div nbsp) (div nbsp)
(div (table
((class "tocviewlist")) ((class "tocviewlist")
(cellspacing "0"))
,@(map (lambda (p) ,@(map (lambda (p)
`(div `(tr
((class "tocviewitem")) (td
(a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))]) ,@(format-number (collected-info-number (part-collected-info p))
(format "~a~a~a" '((tt nbsp))))
(from-root (car dest) (td
(get-dest-directory)) (a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
(if (caddr dest) (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) (if (caddr dest)
"tocviewselflink" ""
"tocviewlink"))) `(part ,(part-tag p))))))
,@(format-number (collected-info-number (part-collected-info p)) (class ,(if (eq? p mine)
'((tt nbsp))) "tocviewselflink"
,@(render-content (part-title-content p) d ht)))) "tocviewlink")))
,@(render-content (part-title-content p) d ht)))))
(part-parts top))))))) (part-parts top)))))))
(define/public (render-one-part d ht fn number) (define/public (render-one-part d ht fn number)

13
collects/scribble/scheme.ss
View File

@ -338,11 +338,14 @@
"#hash" "#hash"
"#hasheq") "#hasheq")
value-color) value-color)
(set! src-col (+ src-col 5 (if equal-table? 2 0))) (let ([delta (+ 5 (if equal-table? 2 0))]
(hash-table-put! next-col-map src-col dest-col) [orig-col src-col])
((loop init-line! +inf.0) (set! src-col (+ src-col delta))
(syntax-ize (hash-table-map (syntax-e c) cons) (hash-table-put! next-col-map src-col dest-col)
(syntax-column c))))] ((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 [else
(advance c init-line!) (advance c init-line!)
(let-values ([(s it? sub?) (let-values ([(s it? sub?)

7
collects/scribble/scribble.css
View File

@ -51,13 +51,12 @@
} }
.tocviewlist { .tocviewlist {
font-size: 80%;
margin: 0.2em 0.2em 0.2em 0.2em; margin: 0.2em 0.2em 0.2em 0.2em;
} }
.tocviewitem { .tocviewlist td {
margin-left: 1em; font-size: 80%;
text-indent: -1em; vertical-align: top;
} }
.tocviewlink { .tocviewlink {