suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finished the docs+tests, added some minor utilities.

Browse Source 
svn: r14199
This commit is contained in:
Eli Barzilay 2009-03-21 15:06:48 +00:00
parent 20dd11d322
commit 1db2b65978
30 changed files with 1293 additions and 599 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/scribble/text/output.ss
View File

@ -2,7 +2,7 @@
(require scheme/promise)
(provide output splice verbatim unverbatim flush prefix)
(provide output)
;; Outputs some value, for the preprocessor langauge.
;;
@ -68,7 +68,7 @@
;; the basic printing unit: strings
(define (output-string x)
(define pfx (mcar pfxs))
(if (not pfx) ; vervatim mode?
(if (not pfx) ; verbatim mode?
(write-string x p)
(let ([len (string-length x)]
[nls (regexp-match-positions* #rx"\n" x)])
@ -105,16 +105,13 @@
;; one, then output the contents recursively (no need to change the
;; state, since we pass the values in the loop, and we'd need to restore
;; it afterwards anyway)
[(pair? x) (let* ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)]
[npfx (pfx+col (pfx+ pfx lpfx))])
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
(if (list? x)
[(pair? x) (if (list? x)
(let* ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)]
[npfx (pfx+col (pfx+ pfx lpfx))])
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
(for ([x (in-list x)]) (loop x))
(let ploop ([x x])
(if (pair? x)
(begin (loop (car x)) (ploop (cdr x)))
(loop x))))
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))]
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))
(begin (loop (car x)) (loop (cdr x))))]
;; delayed values
[(and (procedure? x) (procedure-arity-includes? x 0)) (loop (x))]
[(promise? x) (loop (force x))]
@ -172,6 +169,10 @@
(set! last (cons p s))
s)))))
;; special constructs
(provide splice verbatim unverbatim flush prefix)
(define-struct special (flag contents))
(define (splice . contents) (make-special 'splice contents))
@ -187,3 +188,25 @@
(let ([spaces (make-string n #\space)])
(if (< n 80) (vector-set! v n spaces) (hash-set! t n spaces))
spaces)))))
;; Convenient utilities
(provide add-newlines)
(define (add-newlines list #:sep [sep "\n"])
(define r
(let loop ([list list])
(if (null? list)
null
(let ([1st (car list)])
(if (or (not 1st) (void? 1st))
(loop (cdr list))
(list* sep 1st (loop (cdr list))))))))
(if (null? r) r (cdr r)))
(provide split-lines)
(define (split-lines list)
(let loop ([list list] [cur '()] [r '()])
(cond
[(null? list) (reverse (cons (reverse cur) r))]
[(equal? "\n" (car list)) (loop (cdr list) '() (cons (reverse cur) r))]
[else (loop (cdr list) (cons (car list) cur) r)])))

1086
collects/scribblings/scribble/preprocessor.scrbl
View File

File diff suppressed because it is too large Load Diff

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

@ -102,25 +102,27 @@
(require scheme/list (for-syntax scheme/base scheme/list))
(define max-textsample-width 35)
(define max-textsample-width 45)
(define (textsample-verbatim-boxes line 1st 2nd more)
(define (textsample-verbatim-boxes line in-text out-text more)
(define (split str) (regexp-split #rx"\n" str))
(define strs1 (split 1st))
(define strs2 (split 2nd))
(define strs1 (split in-text))
(define strs2 (split out-text))
(define strsm (map (compose split cdr) more))
(define (str->elts str)
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(list* (substring str 0 (caar spaces))
(hspace (- (cdar spaces) (caar spaces)))
(str->elts (substring str (cdar spaces))))
(list (make-element 'tt (list str))))))
(if (equal? str "")
(list (make-element 'newline (list "")))
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(list* (substring str 0 (caar spaces))
(hspace (- (cdar spaces) (caar spaces)))
(str->elts (substring str (cdar spaces))))
(list (make-element 'tt (list str)))))))
(define (make-line str) (list (as-flow (make-element 'tt (str->elts str)))))
(define (make-box strs) (make-table 'boxed (map make-line strs)))
(define box1 (make-box strs1))
(define box2 (make-box strs2))
(define boxm (map make-box strsm))
(define (small-attr attr)
(make-with-attributes attr '([style . "font-size: 82%;"])))
(define (make-box strs)
(make-table (small-attr 'boxed) (map make-line strs)))
(define filenames (map car more))
(define indent (let ([d (- max-textsample-width
(for*/fold ([m 0])
@ -130,20 +132,27 @@
(if (negative? d)
(error 'textsample-verbatim-boxes
"left box too wide for sample at line ~s" line)
(hspace d))))
(make-element 'tt (list (hspace d))))))
;; Note: the font-size property is reset for every table, so we need it
;; everywhere there's text, and they don't accumulate for nested tables
(values
(make-table '([alignment right left] [valignment top top])
(cons (list (as-flow indent) (as-flow box1))
(make-table (make-with-attributes
'([alignment right left] [valignment top top])
'())
(cons (list (as-flow (make-table (small-attr #f)
(list (list (as-flow indent)))))
(as-flow (make-box strs1)))
(map (lambda (file strs)
(let* ([file (make-element 'tt (list file ":" 'nbsp))]
[file (list (make-element 'italic (list file)))])
(list (as-flow (make-element '(bg-color 232 232 255) file))
(as-flow (make-box strs)))))
filenames strsm)))
box2))
(make-box strs2)))
(define (textsample line 1st 2nd . more)
(define-values (box1 box2) (textsample-verbatim-boxes line 1st 2nd more))
(define (textsample line in-text out-text more)
(define-values (box1 box2)
(textsample-verbatim-boxes line in-text out-text more))
(make-table '([alignment left left left] [valignment center center center])
(list (map as-flow (list box1 (make-paragraph '(nbsp rarr nbsp)) box2)))))
@ -164,34 +173,37 @@
(define-syntax (example stx)
(define sep-rx #px"^---[*]{3}---(?: +(.*))?$")
(define file-rx #rx"^[a-z0-9_.+-]+$")
(syntax-case stx ()
[(_ x ...)
(let loop ([xs #'(x ...)] [text '(#f)] [texts '()])
(syntax-case xs ()
[("\n" sep "\n" . xs)
(and (string? (syntax-e #'sep))
(regexp-match? sep-rx (syntax-e #'sep)))
(let ([m (cond [(regexp-match sep-rx (syntax-e #'sep)) => cadr]
[else #f])])
(if (and m (not (regexp-match? file-rx m)))
(raise-syntax-error #f "bad filename specified" stx #'sep)
(loop #'xs
(list (and m (datum->syntax #'sep m #'sep #'sep)))
(cons (reverse text) texts))))]
[(x . xs) (loop #'xs (cons #'x text) texts)]
[() (let ([texts (reverse (cons (reverse text) texts))]
[line (syntax-line stx)])
(define-values (files i/o) (partition car texts))
(unless ((length i/o) . = . 2)
(raise-syntax-error
'example "need at least an input and an output block" stx))
(with-syntax ([line line]
[((i/o ...) ...) (map cdr i/o)]
[((file text ...) ...) files]
[add-to-tests (cadr tests-ids)])
(syntax/loc stx
(let ([t (list line (string-append i/o ...) ...
(cons file (string-append text ...)) ...)])
(add-to-tests t)
(apply textsample t)))))]
[_ (raise-syntax-error #f "no separator found in example text")]))]))
(define-values (body hidden?)
(syntax-case stx ()
[(_ #:hidden x ...) (values #'(x ...) #t)]
[(_ x ...) (values #'(x ...) #f)]))
(let loop ([xs body] [text '(#f)] [texts '()])
(syntax-case xs ()
[("\n" sep "\n" . xs)
(and (string? (syntax-e #'sep)) (regexp-match? sep-rx (syntax-e #'sep)))
(let ([m (cond [(regexp-match sep-rx (syntax-e #'sep)) => cadr]
[else #f])])
(if (and m (not (regexp-match? file-rx m)))
(raise-syntax-error #f "bad filename specified" stx #'sep)
(loop #'xs
(list (and m (datum->syntax #'sep m #'sep #'sep)))
(cons (reverse text) texts))))]
[(x . xs) (loop #'xs (cons #'x text) texts)]
[() (let ([texts (reverse (cons (reverse text) texts))]
[line (syntax-line stx)])
(define-values (files i/o) (partition car texts))
(unless ((length i/o) . = . 2)
(raise-syntax-error
'example "need at least an input and an output block" stx))
(with-syntax ([line line]
[((in ...) (out ...)) (map cdr i/o)]
[((file text ...) ...) files]
[add-to-tests (cadr tests-ids)])
(quasisyntax/loc stx
(let* ([in-text (string-append in ...)]
[out-text (string-append out ...)]
[more (list (cons file (string-append text ...)) ...)])
(add-to-tests (list line in-text out-text more))
#,(if hidden? #'""
#'(textsample line in-text out-text more))))))]
[_ (raise-syntax-error #f "no separator found in example text")])))

236
collects/tests/scribble/main.ss
View File

@ -1,107 +1,147 @@
#lang scheme/base
(require tests/eli-tester scribble/text/syntax-utils scheme/runtime-path
scheme/sandbox (lib "scribblings/scribble/preprocessor.scrbl"))
(require tests/eli-tester scribble/text/syntax-utils
scheme/runtime-path scheme/port scheme/sandbox
(prefix-in doc: (lib "scribblings/scribble/preprocessor.scrbl")))
(define-runtime-path text-dir "text")
(define-runtime-path this-dir ".")
(test
(define (tests)
(begin/collect-tests)
(preprocessor-tests))
;; begin/collect scope etc
(begin/collect 1) => 1
(begin/collect 1 2 3) => '(1 2 3)
(begin/collect) => '()
(begin/collect (define x 1) x) => 1
(begin/collect (define x 1)) => '()
(begin/collect (define x 1) x x x) => '(1 1 1)
(begin/collect (define x 1) (define y 2) x y x y) => '(1 2 1 2)
(begin/collect (define x 1) x (define y 2) y) => '(1 2)
(begin/collect (define x 1) x (define y 2)) => '(1)
(begin/collect (define x 1) x x (define y 2) y y) => '(1 1 2 2)
(begin/collect (define x 1) x (define x 2) x) => '(1 2)
(begin/collect (define x 1) x x (define x 2) x x) => '(1 1 2 2)
(begin/collect (define (x) y) (define y 1) (x) (x) (x)) => '(1 1 1)
(begin/collect (define x 1) x (define y 2) x) => '(1 1)
(begin/collect (define x 1) x x (define y 2) x x) => '(1 1 1 1)
(begin/collect (define x 1) x x (define y x) y y) => '(1 1 1 1)
(begin/collect (define (x) y) (define y 1) (x) (x)
(define (x) y) (define y 2) (x) (x))
=> '(1 1 2 2)
(begin/collect (define-syntax-rule (DEF x y) (define x y)) (DEF x 1) x x)
=> '(1 1)
(begin/collect (define-syntax-rule (DEF x y) (define x y)) 1 (DEF x 2) x)
=> '(1 2)
(begin/collect (define-syntax-rule (DEF x y) (define x y))
(DEF x 1) x x
(DEF x 2) x x)
=> '(1 1 2 2)
(begin/collect (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(DEF y 1) (x) (x)
(DEF y 2) (x) (x))
=> '(1 1 1 1)
(let ([y 1]) (begin/collect y y (define x y) x y x)) => '(1 1 1 1 1)
(let ([y 1]) (begin/collect y y (define y 2) y y)) => '(1 1 2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x))) => '(1 1)
(let ([y 1]) (begin/collect (define (x) y) (define y 2) (x) (x))) => '(2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y))
=> '(1 1 2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y (x)))
=> '(1 1 2 2 1)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) (x) y y))
=> '(1 1 1 2 2)
(begin/collect (begin (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(define y 2))
(x) (x))
=> '(2 2)
(begin/collect (define (x) y)
(begin (define-syntax-rule (DEF x y) (define x y))
(define y 2))
(x) (x))
=> '(2 2)
(begin/collect (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(begin (define y 2))
(x) (x))
=> '(2 2)
(begin/collect (begin (begin (begin (define (x) y))
(begin (define-syntax-rule (DEF x y)
(define x y))))
(begin (begin (define y 2))
(begin (x)))
(begin (x))))
=> '(2 2)
(begin/collect 1
(define (f x #:< [< "<"] #:> [> ">"]) (list < x >))
(f 1)
(f #:< "[" 2)
(f 3 #:> "]" #:< "["))
=> '(1 ("<" 1 ">") ("[" 2 ">") ("[" 3 "]"))
(define (begin/collect-tests)
(test
;; preprocessor tests
(parameterize ([current-directory text-dir])
(for ([ifile (map path->string (directory-list))]
#:when (and (file-exists? ifile)
(regexp-match? #rx"^i[0-9]+\\.ss$" ifile)))
(define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt"))
(define expected (call-with-input-file ofile
(lambda (i) (read-bytes (file-size ofile) i))))
(define o (open-output-bytes))
(parameterize ([current-output-port o])
(dynamic-require (path->complete-path ifile) #f))
(test (get-output-bytes o) => expected)))
;; preprocessor tests that are part of the documentation
(parameterize ([current-directory this-dir]
[sandbox-output 'string]
[sandbox-error-output current-output-port])
(define (text-test line in out . more)
(define e (make-module-evaluator in))
(test
#:failure-message (format "preprocessor test failure at line ~s" line)
(equal? (get-output e) out)))
(call-with-trusted-sandbox-configuration
(lambda () (for ([t (in-list (tests))]) (apply text-test t)))))
;; begin/collect scope etc
(begin/collect 1) => 1
(begin/collect 1 2 3) => '(1 2 3)
(begin/collect) => '()
(begin/collect (define x 1) x) => 1
(begin/collect (define x 1)) => '()
(begin/collect (define x 1) x x x) => '(1 1 1)
(begin/collect (define x 1) (define y 2) x y x y) => '(1 2 1 2)
(begin/collect (define x 1) x (define y 2) y) => '(1 2)
(begin/collect (define x 1) x (define y 2)) => '(1)
(begin/collect (define x 1) x x (define y 2) y y) => '(1 1 2 2)
(begin/collect (define x 1) x (define x 2) x) => '(1 2)
(begin/collect (define x 1) x x (define x 2) x x) => '(1 1 2 2)
(begin/collect (define (x) y) (define y 1) (x) (x) (x)) => '(1 1 1)
(begin/collect (define x 1) x (define y 2) x) => '(1 1)
(begin/collect (define x 1) x x (define y 2) x x) => '(1 1 1 1)
(begin/collect (define x 1) x x (define y x) y y) => '(1 1 1 1)
(begin/collect (define (x) y) (define y 1) (x) (x)
(define (x) y) (define y 2) (x) (x))
=> '(1 1 2 2)
(begin/collect (define-syntax-rule (DEF x y) (define x y)) (DEF x 1) x x)
=> '(1 1)
(begin/collect (define-syntax-rule (DEF x y) (define x y)) 1 (DEF x 2) x)
=> '(1 2)
(begin/collect (define-syntax-rule (DEF x y) (define x y))
(DEF x 1) x x
(DEF x 2) x x)
=> '(1 1 2 2)
(begin/collect (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(DEF y 1) (x) (x)
(DEF y 2) (x) (x))
=> '(1 1 1 1)
(let ([y 1]) (begin/collect y y (define x y) x y x)) => '(1 1 1 1 1)
(let ([y 1]) (begin/collect y y (define y 2) y y)) => '(1 1 2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x))) => '(1 1)
(let ([y 1]) (begin/collect (define (x) y) (define y 2) (x) (x))) => '(2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y))
=> '(1 1 2 2)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y (x)))
=> '(1 1 2 2 1)
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) (x) y y))
=> '(1 1 1 2 2)
(begin/collect (begin (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(define y 2))
(x) (x))
=> '(2 2)
(begin/collect (define (x) y)
(begin (define-syntax-rule (DEF x y) (define x y))
(define y 2))
(x) (x))
=> '(2 2)
(begin/collect (define (x) y)
(define-syntax-rule (DEF x y) (define x y))
(begin (define y 2))
(x) (x))
=> '(2 2)
(begin/collect (begin (begin (begin (define (x) y))
(begin (define-syntax-rule (DEF x y)
(define x y))))
(begin (begin (define y 2))
(begin (x)))
(begin (x))))
=> '(2 2)
(begin/collect 1
(define (f x #:< [< "<"] #:> [> ">"]) (list < x >))
(f 1)
(f #:< "[" 2)
(f 3 #:> "]" #:< "["))
=> '(1 ("<" 1 ">") ("[" 2 ">") ("[" 3 "]"))
)
))
(define (preprocessor-tests)
;; (sample-file-tests)
(in-documentation-tests))
(define (sample-file-tests)
(parameterize ([current-directory text-dir])
(for ([ifile (map path->string (directory-list))]
#:when (and (file-exists? ifile)
(regexp-match? #rx"^i[0-9]+\\.ss$" ifile)))
(define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt"))
(define expected (call-with-input-file ofile
(lambda (i) (read-bytes (file-size ofile) i))))
(define o (open-output-bytes))
(parameterize ([current-output-port o])
(dynamic-require (path->complete-path ifile) #f))
(test (get-output-bytes o) => expected))))
(define (in-documentation-tests)
(define (text-test line in-text out-text more)
(define-values (i o) (make-pipe 512))
(define-values (expected len-to-read)
(let ([m (regexp-match-positions #rx"\n\\.\\.\\.$" out-text)])
(if m
(values (substring out-text 0 (caar m)) (caar m))
(values out-text #f))))
;; test with name indicating the source
(define-syntax-rule (t . stuff)
(test ;#:failure-message
;(format "preprocessor test failure at line ~s" line)
. stuff))
(parameterize ([current-directory this-dir]
[sandbox-output o]
[sandbox-error-output current-output-port])
(define exn #f)
(define thd #f)
(define (run)
;; only need to evaluate the module, so we have its output; but do that
;; in a thread, since we might want to look at just a prefix of an
;; infinite output
(with-handlers ([void (lambda (e) (set! exn e))])
(make-module-evaluator in-text)
(close-output-port o)))
(for ([m more])
(call-with-output-file (car m) #:exists 'truncate
(lambda (o) (display (cdr m) o))))
(set! thd (thread run))
(t (with-limits 1 #f
(if len-to-read (read-string len-to-read i) (port->string i)))
=> expected)
(t (begin (kill-thread thd) (cond [exn => raise] [else #t])))))
(call-with-trusted-sandbox-configuration
(lambda ()
(for ([t (in-list (doc:tests))])
(begin (apply text-test t))))))
;; run all
(test do (tests))

3
collects/tests/scribble/text/i01.ss
View File

@ -1,3 +0,0 @@
#lang scribble/text
foo

25
collects/tests/scribble/text/i02.ss
View File

@ -1,25 +0,0 @@
#lang scribble/text
@define[name]{PLT Scheme}
Suggested price list for "@name"
@; test mutual recursion, throwing away inter-definition spaces
@; <-- this is needed to get only one line of space above
@(define (items-num)
(length items))
@(define average
(delay (/ (apply + (map car items)) (length items))))
@(define items
(list @list[99]{Home}
@list[149]{Professional}
@list[349]{Enterprize}))
@(for/list ([i items] [n (in-naturals)])
@list{@|n|. @name @cadr[i] edition: $@car[i].99
@||})@; <-- also needed
Total: @items-num items
Average price: $@|average|.99

18
collects/tests/scribble/text/i03.ss
View File

@ -1,18 +0,0 @@
#lang scribble/text
---***---
@(define (angled . body) (list "<" body ">"))
@(define (shout . body) @angled[(map string-upcase body)])
@define[z]{blah}
blah @angled{blah @shout{@z} blah} blah
@(define-syntax-rule @twice[x]
(list x ", " x))
@twice{@twice{blah}}
@include{i03a}
@(let ([name "Eli"]) (let ([foo (include "i03b")]) (list foo "\n" foo)))
Repeating yourself much?

1
collects/tests/scribble/text/i03a
View File

@ -1 +0,0 @@
Warning: blah overdose might be fatal

12
collects/tests/scribble/text/i03b
View File

@ -1,12 +0,0 @@
@(define (foo . xs) (bar xs))
@(begin (define (isname) @list{is @foo{@name}})
(define-syntax-rule (DEF x y) (define x y)))
@(DEF (bar x) (list z " " x))
@(define-syntax-rule (BEG x ...) (begin x ...))
@(BEG (define z "zee"))
My name @isname
@DEF[x]{Foo!}
... and to that I say "@x", I think.

24
collects/tests/scribble/text/i04.ss
View File

@ -1,24 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@; demonstrates how indentation is preserved inside lists
begin
a
b
@list{c
d
@list{e
f
g}
h
i
@list{j
k
l}
m
n
o}
p
q
end

30
collects/tests/scribble/text/i05.ss
View File

@ -1,30 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@(define (((if . c) . t) . e)
@list{
if (@c)
@t
else
@e
fi})
@; indentation works even when coming from a function
function foo() {
@list{if (1 < 2)
something1
else
@@@if{2<3}{something2}{something3}
repeat 3 {
@@@if{2<3}{something2}{something3}
@@@if{2<3}{
@list{something2.1
something2.2}
}{
something3
}
}
fi}
return
}

25
collects/tests/scribble/text/i06.ss
View File

@ -1,25 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@; indentation works with a list, even a single string with a newline
@; in a list, but not in a string by itself
function foo() {
prefix
@list{if (1 < 2)
something1
else
@list{something2
something3}
@'("something4\nsomething5")
@"something6\nsomething7"
fi}
return
}
@; can be used with a `display', but makes sense only at the top level
@; or in thunks (not demonstrated here)
@;
@(display 123) foo @list{bar1
bar2
bar2}

18
collects/tests/scribble/text/i07.ss
View File

@ -1,18 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@; demonstrates using a prefix
function foo() {
var lst = [@list{item1,
item2}]
@prefix["//"]{ comment1
comment2
comment3
@list{comment4
comment5
comment6}
@prefix["*"]{ more
stuff}}
return
}

17
collects/tests/scribble/text/i08.ss
View File

@ -1,17 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@; using verbatim
@(define (((foo . var) . expr1) . expr2)
@list{int var;
@verbatim{#ifdef FOO}
var = [@expr1,
@expr2];
@verbatim{#else}
var = [@expr2,
@expr1];
@verbatim{#endif}})
int blah() {
@@@foo{i}{something}{something_else}
}

25
collects/tests/scribble/text/i09.ss
View File

@ -1,25 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@(begin
;; This is a somewhat contrived example, showing how to use lists
;; and verbatim to control the added prefix
(define (item . text)
;; notes: the `flush' makes the prefix to that point print so the
;; verbatim "* " is printed after it, which overwrites the "| "
;; prefix
(cons flush (prefix "| " (cons (verbatim "* ") text))))
;; note that a simple item with spaces is much easier:
(define (simple . text) @list{* @text}))
start
@item{blah blah blah
blah blah blah
@item{more stuff
more stuff
more stuff}
blah blah blah
blah blah blah}
@simple{more blah
blah blah}
end

33
collects/tests/scribble/text/i10.ss
View File

@ -1,33 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@(define (((if . c) . t) . e)
@list{if (@c)
@t
else
@e
fi})
function foo() {
@prefix["//"]{ comment1
comment2 @list{comment3
comment4}}
var x = [@list{item1,
item2}]
bar1
@list{if (1 < 2)
@list{something1
something2
something3}
else
@@@if{2 < 3}{something_else}{something_completely_different}
@@@if{3 < 4}{
another_something_else1
another_something_else2
}{
another_something_completely_different
}
fi
}
return;
}

13
collects/tests/scribble/text/i11.ss
View File

@ -1,13 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@(define (block x)
@splice{{
blah(@x);
}})
start
@splice{foo();
loop:}
@list{if (something) @block{stuff}}
end

10
collects/tests/scribble/text/i12.ss
View File

@ -1,10 +0,0 @@
#!/bin/env mzscheme
#lang scribble/text
@list{
a
b
}
c

1
collects/tests/scribble/text/o01.txt
View File

@ -1 +0,0 @@
foo

8
collects/tests/scribble/text/o02.txt
View File

@ -1,8 +0,0 @@
Suggested price list for "PLT Scheme"
0. PLT Scheme Home edition: $99.99
1. PLT Scheme Professional edition: $149.99
2. PLT Scheme Enterprize edition: $349.99
Total: 3 items
Average price: $199.99

14
collects/tests/scribble/text/o03.txt
View File

@ -1,14 +0,0 @@
---***---
blah <blah <BLAH> blah> blah
blah, blah, blah, blah
Warning: blah overdose might be fatal
My name is zee Eli
... and to that I say "Foo!", I think.
My name is zee Eli
... and to that I say "Foo!", I think.
Repeating yourself much?

19
collects/tests/scribble/text/o04.txt
View File

@ -1,19 +0,0 @@
begin
a
b
c
d
e
f
g
h
i
j
k
l
m
n
o
p
q
end

25
collects/tests/scribble/text/o05.txt
View File

@ -1,25 +0,0 @@
function foo() {
if (1 < 2)
something1
else
if (2<3)
something2
else
something3
fi
repeat 3 {
if (2<3)
something2
else
something3
fi
if (2<3)
something2.1
something2.2
else
something3
fi
}
fi
return
}

18
collects/tests/scribble/text/o06.txt
View File

@ -1,18 +0,0 @@
function foo() {
prefix
if (1 < 2)
something1
else
something2
something3
something4
something5
something6
something7
fi
return
}
123 foo bar1
bar2
bar2

13
collects/tests/scribble/text/o07.txt
View File

@ -1,13 +0,0 @@
function foo() {
var lst = [item1,
item2]
// comment1
// comment2
// comment3
// comment4
// comment5
// comment6
// * more
// * stuff
return
}

10
collects/tests/scribble/text/o08.txt
View File

@ -1,10 +0,0 @@
int blah() {
int var;
#ifdef FOO
var = [something,
something_else];
#else
var = [something_else,
something];
#endif
}

11
collects/tests/scribble/text/o09.txt
View File

@ -1,11 +0,0 @@
start
* blah blah blah
| blah blah blah
| * more stuff
| | more stuff
| | more stuff
| blah blah blah
| blah blah blah
* more blah
blah blah
end

26
collects/tests/scribble/text/o10.txt
View File

@ -1,26 +0,0 @@
function foo() {
// comment1
// comment2 comment3
// comment4
var x = [item1,
item2]
bar1
if (1 < 2)
something1
something2
something3
else
if (2 < 3)
something_else
else
something_completely_different
fi
if (3 < 4)
another_something_else1
another_something_else2
else
another_something_completely_different
fi
fi
return;
}

7
collects/tests/scribble/text/o11.txt
View File

@ -1,7 +0,0 @@
start
foo();
loop:
if (something) {
blah(stuff);
}
end

5
collects/tests/scribble/text/o12.txt
View File

@ -1,5 +0,0 @@
a
b
c