121 lines
4.0 KiB
Scheme
121 lines
4.0 KiB
Scheme
|
|
(module utils scheme/base
|
|
(require scribble/struct
|
|
scribble/manual
|
|
(prefix-in scheme: scribble/scheme)
|
|
(prefix-in scribble: scribble/reader))
|
|
|
|
(define-syntax bounce-for-label
|
|
(syntax-rules (all-except)
|
|
[(_ (all-except mod (id ...) (id2 ...)))
|
|
(begin
|
|
(require (for-label (except-in mod id ...)))
|
|
(provide (for-label (except-out (all-from-out mod) id2 ...))))]
|
|
[(_ mod) (begin
|
|
(require (for-label mod))
|
|
(provide (for-label (all-from-out mod))))]
|
|
[(_ mod ...) (begin (bounce-for-label mod) ...)]))
|
|
|
|
(bounce-for-label (all-except scheme (link) ())
|
|
scribble/struct
|
|
scribble/base-render
|
|
scribble/decode
|
|
scribble/manual
|
|
scribble/scheme
|
|
scribble/eval
|
|
scribble/bnf)
|
|
|
|
(provide scribble-examples litchar/lines)
|
|
|
|
(define (litchar/lines . strs)
|
|
(let ([strs (regexp-split #rx"\n" (apply string-append strs))])
|
|
(if (= 1 (length strs))
|
|
(litchar (car strs))
|
|
(make-table
|
|
#f
|
|
(map (lambda (s)
|
|
(list (make-flow (list (make-paragraph
|
|
(if (string=? s "")
|
|
'(nbsp) ; needed for IE
|
|
(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
|
|
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
|
|
p
|
|
(syntax-e p)
|
|
(list (syntax-source p)
|
|
(syntax-line p)
|
|
base
|
|
(add1 base)
|
|
1)
|
|
p)]))
|
|
|
|
(define (scribble-examples . lines)
|
|
(define reads-as (make-paragraph (list spacer "reads as" spacer)))
|
|
(let* ([lines (apply string-append lines)]
|
|
[p (open-input-string lines)])
|
|
(port-count-lines! p)
|
|
(let loop ([r '()] [newlines? #f])
|
|
(regexp-match? #px#"^[[:space:]]*" p)
|
|
(let* ([p1 (file-position p)]
|
|
[stx (scribble:read-syntax #f p)]
|
|
[p2 (file-position p)])
|
|
(if (not (eof-object? stx))
|
|
(let ([str (substring lines p1 p2)])
|
|
(loop (cons (list str stx) r)
|
|
(or newlines? (regexp-match? #rx#"\n" str))))
|
|
(let* ([r (reverse r)]
|
|
[r (if newlines?
|
|
(cdr (apply append (map (lambda (x) (list #f x)) r)))
|
|
r)])
|
|
(make-table
|
|
#f
|
|
(map (lambda (x)
|
|
(let ([@expr (if x (litchar/lines (car x)) "")]
|
|
[sexpr (if x
|
|
(scheme:to-paragraph
|
|
((norm-spacing 0) (cadr x)))
|
|
"")]
|
|
[reads-as (if x reads-as "")])
|
|
(map as-flow (list spacer @expr reads-as sexpr))))
|
|
r)))))))))
|