suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 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 defs+int
examples examples
defexamples defexamples
as-examples
current-int-namespace current-int-namespace
eval-example-string eval-example-string
@ -150,6 +151,10 @@
(vector-set! v2 i (copy-value (vector-ref v i) ht)) (vector-set! v2 i (copy-value (vector-ref v i) ht))
(loop i)))) (loop i))))
v2)] v2)]
[(box? v) (let ([v2 (box #f)])
(hash-table-put! ht v v2)
(set-box! v2 (copy-value (unbox v) ht))
v2)]
[else v])) [else v]))
(define (strip-comments s) (define (strip-comments s)
@ -209,12 +214,15 @@
(make-paragraph null)))) (make-paragraph null))))
(define-syntax (schemedefinput* stx) (define-syntax (schemedefinput* stx)
(syntax-case stx (eval-example-string define) (syntax-case stx (eval-example-string define define-struct)
[(_ (eval-example-string s)) [(_ (eval-example-string s))
#'(schemeinput* (eval-example-string s))] #'(schemeinput* (eval-example-string s))]
[(_ (define . rest)) [(_ (define . rest))
(syntax-case stx () (syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])] [(_ e) #'(defspace (schemeblock e))])]
[(_ (define-struct . rest))
(syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])]
[(_ (code:line (define . rest) . rest2)) [(_ (code:line (define . rest) . rest2))
(syntax-case stx () (syntax-case stx ()
[(_ e) #'(defspace (schemeblock e))])] [(_ e) #'(defspace (schemeblock e))])]
@ -266,5 +274,11 @@
(define-syntax defexamples (define-syntax defexamples
(syntax-rules () (syntax-rules ()
[(_ e ...) [(_ 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 (let ([s (apply string-append
(map (lambda (s) (if (string=? s "\n") " " s)) (map (lambda (s) (if (string=? s "\n") " " s))
strs))]) 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" (make-element "schemeinput"
(list (hspace (cdar spaces)) (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) (define (verbatim s)
(let ([strs (regexp-split #rx"\n" s)]) (let ([strs (regexp-split #rx"\n" s)])
@ -134,7 +136,7 @@
var svar void-const) var svar void-const)
(define (void-const) (define (void-const)
"void") (schemefont "#<void>"))
(define dots0 (define dots0
(make-element #f (list "..."))) (make-element #f (list "...")))

12
collects/scribble/scheme.ss
View File

@ -248,6 +248,12 @@
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))]
[(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)) [(hash-table? (syntax-e c))
(advance c init-line!) (advance c init-line!)
(let ([equal-table? (hash-table? (syntax-e c) 'equal)]) (let ([equal-table? (hash-table? (syntax-e c) 'equal)])
@ -444,5 +450,11 @@
(cons a b) (cons a b)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 2 sep (syntax-span a) (syntax-span b)))))] (+ 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 [else
(datum->syntax-object #f v (list #f 1 col (+ 1 col) 1))]))) (datum->syntax-object #f v (list #f 1 col (+ 1 col) 1))])))