92 lines
2.8 KiB
Scheme
92 lines
2.8 KiB
Scheme
|
|
(module utils mzscheme
|
|
(require (lib "struct.ss" "scribble")
|
|
(lib "manual.ss" "scribble")
|
|
(prefix scheme: (lib "scheme.ss" "scribble"))
|
|
(prefix scribble: (lib "reader.ss" "scribble"))
|
|
(lib "string.ss"))
|
|
|
|
(provide at
|
|
litchar/lines
|
|
scribble-examples)
|
|
|
|
(define at "@")
|
|
|
|
(define (litchar/lines s)
|
|
(let ([strs (regexp-split #rx"\n" s)])
|
|
(if (= 1 (length strs))
|
|
(litchar s)
|
|
(make-table
|
|
#f
|
|
(map (lambda (s)
|
|
(list (make-flow (list (make-paragraph (list (litchar s)))))))
|
|
strs)))))
|
|
|
|
(define (as-flow e)
|
|
(make-flow (list (if (flow-element? e)
|
|
e
|
|
(make-paragraph (list e))))))
|
|
|
|
(define spacer (hspace 2))
|
|
|
|
(define ((norm-spacing base) p)
|
|
(cond
|
|
[(and (syntax->list p)
|
|
(not (null? (syntax-e p))))
|
|
(let loop ([e (syntax->list p)]
|
|
[line (syntax-line (car (syntax-e p)))]
|
|
[pos base]
|
|
[second #f]
|
|
[accum null])
|
|
(cond
|
|
[(null? e)
|
|
(datum->syntax-object
|
|
p
|
|
(reverse accum)
|
|
(list (syntax-source p)
|
|
(syntax-line p)
|
|
base
|
|
(add1 base)
|
|
(- pos base))
|
|
p)]
|
|
[else
|
|
(let* ([v ((norm-spacing (if (= line (syntax-line (car e)))
|
|
pos
|
|
(or second pos)))
|
|
(car e))]
|
|
[next-pos (+ (syntax-column v) (syntax-span v) 1)])
|
|
(loop (cdr e)
|
|
(syntax-line v)
|
|
next-pos
|
|
(or second next-pos)
|
|
(cons v accum)))]))]
|
|
[else
|
|
(datum->syntax-object
|
|
p
|
|
(syntax-e p)
|
|
(list (syntax-source p)
|
|
(syntax-line p)
|
|
base
|
|
(add1 base)
|
|
1)
|
|
p)]))
|
|
|
|
(define (scribble-examples . lines)
|
|
(make-table
|
|
#f
|
|
(map (lambda (line)
|
|
(let ([line (if (string? line)
|
|
(list (litchar/lines line)
|
|
(scheme:to-paragraph
|
|
(let ([p (open-input-string line)])
|
|
(port-count-lines! p)
|
|
(if (regexp-match? #rx"\n" line)
|
|
((norm-spacing 0) (scribble:read-syntax #f p))
|
|
(scribble:read p)))))
|
|
line)])
|
|
(list (as-flow spacer)
|
|
(as-flow (if line (car line) ""))
|
|
(as-flow (if line (make-paragraph (list spacer "reads as" spacer)) ""))
|
|
(as-flow (if line (cadr line) "")))))
|
|
lines))))
|