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 (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)

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

@ -77,11 +77,15 @@
(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"))
`(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)
@ -95,9 +99,7 @@
(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))))
,@(render-content (part-title-content p) d ht)))))
(part-parts top)))))))
(define/public (render-one-part d ht fn number)

7
collects/scribble/scheme.ss
View File

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

7
collects/scribble/scribble.css
View File

@ -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 {