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

reformat using #lang

Browse Source 
svn: r14103

original commit: eb62b52d3af646a32eb842087c91743bdb815f94
This commit is contained in:
Eli Barzilay 2009-03-15 01:06:57 +00:00
parent 7d488fa96b
commit 208edf6016
1 changed files with 93 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
collects/scribblings/scribble/utils.ss
View File

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