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

370.2

Browse Source 
svn: r6369

original commit: e9385a910eac5c2f84dccbe6d66fed0741200785
This commit is contained in:
Matthew Flatt 2007-05-29 03:26:32 +00:00
parent 497610de8d
commit da1bfdad73
3 changed files with 33 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scribble/eval.ss
View File

@ -17,6 +17,7 @@
defs+int
examples
defexamples
as-examples
current-int-namespace
eval-example-string
@ -150,6 +151,10 @@
(vector-set! v2 i (copy-value (vector-ref v i) ht))
(loop i))))
v2)]
[(box? v) (let ([v2 (box #f)])
(hash-table-put! ht v v2)
(set-box! v2 (copy-value (unbox v) ht))
v2)]
[else v]))
(define (strip-comments s)
@ -209,12 +214,15 @@
(make-paragraph null))))
(define-syntax (schemedefinput* stx)
(syntax-case stx (eval-example-string define)
(syntax-case stx (eval-example-string define define-struct)
[(_ (eval-example-string s))
#'(schemeinput* (eval-example-string s))]
[(_ (define . rest))
(syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])]
[(_ (define-struct . rest))
(syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])]
[(_ (code:line (define . rest) . rest2))
(syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])]
@ -266,5 +274,11 @@
(define-syntax defexamples
(syntax-rules ()
[(_ e ...)
(titled-interaction example-title schemedefinput* e ...)])))
(titled-interaction example-title schemedefinput* e ...)]))
(define (as-examples t)
(make-table #f
(list
(list example-title)
(list (make-flow (list t)))))))

8
collects/scribble/manual.ss
View File

@ -54,10 +54,12 @@
(let ([s (apply string-append
(map (lambda (s) (if (string=? s "\n") " " s))
strs))])
(let ([spaces (regexp-match-positions #rx"^ *" s)])
(let ([spaces (regexp-match-positions #rx"^ *" s)]
[end-spaces (regexp-match-positions #rx" *$" s)])
(make-element "schemeinput"
(list (hspace (cdar spaces))
(make-element 'tt (list (substring s (cdar spaces)))))))))
(make-element 'tt (list (substring s (cdar spaces) (caar end-spaces))))
(hspace (- (cdar end-spaces) (caar end-spaces))))))))
(define (verbatim s)
(let ([strs (regexp-split #rx"\n" s)])
@ -134,7 +136,7 @@
var svar void-const)
(define (void-const)
"void")
(schemefont "#<void>"))
(define dots0
(make-element #f (list "...")))

12
collects/scribble/scheme.ss
View File

@ -248,6 +248,12 @@
p-color)
(set! src-col (+ src-col 1))
(hash-table-put! col-map src-col dest-col))]
[(box? (syntax-e c))
(advance c init-line!)
(out "#&" value-color)
(set! src-col (+ src-col 2))
(hash-table-put! col-map src-col dest-col)
((loop init-line! +inf.0) (unbox (syntax-e c)))]
[(hash-table? (syntax-e c))
(advance c init-line!)
(let ([equal-table? (hash-table? (syntax-e c) 'equal)])
@ -444,5 +450,11 @@
(cons a b)
(list #f 1 col (+ 1 col)
(+ 2 sep (syntax-span a) (syntax-span b)))))]
[(box? v)
(let ([a (syntax-ize (unbox v) (+ col 2))])
(datum->syntax-object #f
(box a)
(list #f 1 col (+ 1 col)
(+ 2 (syntax-span a)))))]
[else
(datum->syntax-object #f v (list #f 1 col (+ 1 col) 1))])))