From da64fcb79723d3bcc9e32fcf2bb9ed24257ef8b5 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 21 Mar 2009 15:06:48 +0000 Subject: [PATCH] Finished the docs+tests, added some minor utilities. svn: r14199 original commit: 1db2b65978b9f2330d2de01f1caaef26f3f2cd3a --- collects/scribble/text/output.ss | 45 +- .../scribblings/scribble/preprocessor.scrbl | 1086 ++++++++++++++++- collects/scribblings/scribble/utils.ss | 114 +- collects/tests/scribble/main.ss | 236 ++-- 4 files changed, 1293 insertions(+), 188 deletions(-) diff --git a/collects/scribble/text/output.ss b/collects/scribble/text/output.ss index 04b32f62..238b25b4 100644 --- a/collects/scribble/text/output.ss +++ b/collects/scribble/text/output.ss @@ -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)]))) diff --git a/collects/scribblings/scribble/preprocessor.scrbl b/collects/scribblings/scribble/preprocessor.scrbl index e502ddc8..5d34ef68 100644 --- a/collects/scribblings/scribble/preprocessor.scrbl +++ b/collects/scribblings/scribble/preprocessor.scrbl @@ -1,6 +1,9 @@ #lang scribble/doc @(require scribble/manual scribble/struct "utils.ss" - (for-label scheme/base)) + (for-label scheme/base + ;; FIXME: need to get this in + ;; scribble/text + )) @initialize-tests @title[#:tag "preprocessor"]{Text Preprocessor} @@ -24,6 +27,12 @@ changes that make it suitable as a preprocessor language: } +@; TODO: +@; * make all example sections be subsections, +@; * add a reference section, +@; * a section on "scribble/text.ss" +@; * maybe a section on additional utilities: begin/text + @;-------------------------------------------------------------------- @section{Writing Preprocessor Files} @@ -44,13 +53,14 @@ part shows the source input, and the right part the printed result.) feature on top of feature, but blah blah blah.}-| -Using @seclink["reader"]|{@-forms}| we can define and use Scheme +Using @seclink["reader"]|{@-forms}|, we can define and use Scheme functions. @example|-{#lang scribble/text @(require scheme/list) @(define Foo "Preprocessing") @(define (3x . x) + ;; scheme syntax here (add-between (list x x x) " ")) @Foo languages should be designed not by piling @@ -65,7 +75,7 @@ functions. As demonstrated in this case, the @scheme[output] function simply scans nested list structures recursively, which makes them convenient for function results. In addition, @scheme[output] prints most values -similarly to @scheme[display] \- a notable exception are void and +similarly to @scheme[display] --- notable exceptions are void and false values which cause no output to appear. This can be used for convenient conditional output. @@ -85,8 +95,8 @@ functions more conveniently too. @example|-{#lang scribble/text @(define (errors n) - @list{@n error@; - @and[(not (= n 1))]{s}}) + ;; note the use of `unless' + @list{@n error@unless[(= n 1)]{s}}) You have @errors[3] in your code, I fixed @errors[1]. ---***--- @@ -108,38 +118,1058 @@ them are ignored. @list{@n error@plural[n]}) You have @errors[3] in your code, - I fixed @errors[1]. + @(define fixed 1) + I fixed @errors[fixed]. ---***--- You have 3 errors in your code, I fixed 1 error.}-| +These end-of-line newline strings are not ignored when they follow +other kinds of expressions, which may lead to redundant empty lines in +the output. + +@example|-{#lang scribble/text + @(define (count n str) + (for/list ([i (in-range 1 (add1 n))]) + @list{@i @str,@"\n"})) + Start... + @count[3]{Mississippi} + ... and I'm done. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + + ... and I'm done.}-| + +There are several ways to avoid having such empty lines in your +output. The simplest way is to arrange for the function call's form +to end right before the next line begins, but this is often not too +convenient. An alternative is to use a @litchar|{@;}| comment, which +makes the scribble reader ignore everything that follows it up to and +including the newline. (These methods can be applied to the line that +precedes the function call too, but the results are likely to have +what looks like erroneous indentation. More about this below.) + +@example|-{#lang scribble/text + @(define (count n str) + (for/list ([i (in-range 1 (+ n 1))]) + @list{@i @str,@"\n"})) + Start... + @count[3]{Mississippi + }... done once. + + Start again... + @count[3]{Massachusetts}@; + ... and I'm done again. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + ... done once. + + Start again... + 1 Massachusetts, + 2 Massachusetts, + 3 Massachusetts, + ... and I'm done again.}-| + +A better approach is to generate newlines only when needed. + +@example|-{#lang scribble/text + @(require scheme/list) + @(define (count n str) + (add-between + (for/list ([i (in-range 1 (+ n 1))]) + @list{@i @str,}) + "\n")) + Start... + @count[3]{Mississippi} + ... and I'm done. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + ... and I'm done.}-| + +In fact, this is common enough that the @scheme[scribble/text] +language provides a convenient facility: @scheme[add-newlines] is a +function that is similar to @scheme[add-between] using a newline +string as the default separator, except that false and void values are +filtered out before doing so. + +@example|-{#lang scribble/text + @(define (count n str) + (add-newlines + (for/list ([i (in-range 1 (+ n 1))]) + @list{@i @str,}))) + Start... + @count[3]{Mississippi} + ... and I'm done. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + ... and I'm done.}-| + +@example|-{#lang scribble/text + @(define (count n str) + (add-newlines + (for/list ([i (in-range 1 (+ n 1))]) + @(and (even? i) @list{@i @str,})))) + Start... + @count[6]{Mississippi} + ... and I'm done. + ---***--- + Start... + 2 Mississippi, + 4 Mississippi, + 6 Mississippi, + ... and I'm done.}-| + +The separator can be set to any value. + +@example|-{#lang scribble/text + @(define (count n str) + (add-newlines #:sep ",\n" + (for/list ([i (in-range 1 (+ n 1))]) + @list{@i @str}))) + Start... + @count[3]{Mississippi}. + ... and I'm done. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi. + ... and I'm done.}-| + + +@;-------------------------------------------------------------------- +@section{Defining Functions and More} + +(Note: most of the tips in this section are applicable to any code +that uses the Scribble @"@"-form syntax.) + +Because the Scribble reader is uniform, you can use it in place of any +expression where it is more convenient. (By convention, we use a +plain S-expression syntax when we want a Scheme expression escape, and +an @"@"-form for expressions that render as text, which, in the +@scheme[scribble/text] language, is any value-producing expression.) +For example, you can use an @"@"-form for a function that you define. + +@example|-{#lang scribble/text + @(define @bold[text] @list{*@|text|*}) + An @bold{important} note. + ---***--- + An *important* note. + }-| + +This is not commonly done, since most functions that operate with text +will need to accept a variable number of arguments. In fact, this +leads to a common problem: what if we want to write a function that +consumes a number of ``text arguments'' rathen than a single +``rest-like'' body? The common solution for this is to provide the +separate text arguments in the S-expression part of an @"@"-form. + +@example|-{#lang scribble/text + @(define (choose 1st 2nd) + @list{Either @1st, or @2nd@"."}) + @(define who "us") + @choose[@list{you're with @who} + @list{against @who}] + ---***--- + Either you're with us, or against us. + }-| + +You can even use @"@"-forms with a Scheme quote or quasiquote as the +``head'' part to make it shorter, or use a macro to get grouping of +sub-parts without dealing with quotes. + +@example|-{#lang scribble/text + @(define (choose 1st 2nd) + @list{Either @1st, or @2nd@"."}) + @(define who "us") + @choose[@list{you're with @who} + @list{against @who}] + @(define-syntax-rule (compare (x ...) ...) + (add-newlines + (list (list "* " x ...) ...))) + Shopping list: + @compare[@{apples} + @{oranges} + @{@(* 2 3) bananas}] + ---***--- + Either you're with us, or against us. + Shopping list: + * apples + * oranges + * 6 bananas + }-| + +Yet another solution is to look at the text values and split the input +arguments based on a specific token. Using @scheme[match] can make it +convenient --- you can even specify the patterns with @"@"-forms. + +@example|-{#lang scribble/text + @(require scheme/match) + @(define (features . text) + (match text + [@list{@1st@... + --- + @2nd@...} + @list{>> Pros << + @1st; + >> Cons << + @|2nd|.}])) + @features{fast, + reliable + --- + expensive, + ugly} + ---***--- + >> Pros << + fast, + reliable; + >> Cons << + expensive, + ugly. + }-| + +In particular, it is often convenient to split the input by lines, +identified by delimiting @scheme["\n"] strings. Since this can be +useful, a @scheme[split-lines] function is provided. + +@example|-{#lang scribble/text + @(require scheme/list) + @(define (features . text) + (add-between (split-lines text) + ", ")) + @features{red + fast + reliable}. + ---***--- + red, fast, reliable. + }-| + +Finally, the Scribble reader accepts @emph{any} expression as the head +part of an @"@"-form --- even an @"@" form. This makes it possible to +get a number of text bodies by defining a curried function, where each +step accepts any number of arguments. This, however, means that the +number of body expressions must be fixed. + +@example|-{#lang scribble/text + @(define ((choose . 1st) . 2nd) + @list{Either you're @1st, or @2nd@"."}) + @(define who "me") + @@choose{with @who}{against @who} + ---***--- + Either you're with me, or against me. + }-| + + +@;-------------------------------------------------------------------- +@section{Using Printouts} + +Because the preprocessor language simply displays each toplevel value +as the file is run, it is possible to print text directly as part of +the output. + +@example|-{#lang scribble/text + First + @display{Second} + Third + ---***--- + First + Second + Third}-| + +Taking this further, it is possible to write functions that output +some text @emph{instead} of returning values that represent the text. + +@example|-{#lang scribble/text + @(define (count n) + (for ([i (in-range 1 (+ n 1))]) + (printf "~a Mississippi,\n" i))) + Start... + @count[3]@; avoid an empty line + ... and I'm done. + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + ... and I'm done.}-| + +This can be used to produce a lot of output text, even infinite. + +@example|-{#lang scribble/text + @(define (count n) + (printf "~a Mississippi,\n" n) + (count (add1 n))) + Start... + @count[1] + this line is never printed! + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + 4 Mississippi, + 5 Mississippi, + ...}-| + +However, you should be careful not to mix returning values with +printouts, as the results are rarely desirable. + +@example|-{#lang scribble/text + @list{1 @display{two} 3} + ---***--- + two1 3}-| + +Note that you don't need side-effects if you want infinite output. +The @scheme[output] function iterates thunks and (composable) +promises, so you can create a loop that is delayed in either form. +@; Note: there is some sfs-related problem in mzscheme that makes it not +@; run in bounded space, so don't show it for nowx. + +@example|-{#lang scribble/text + @(define (count n) + (cons @list{@n Mississippi,@"\n"} + (lambda () + (count (add1 n))))) + Start... + @count[1] + this line is never printed! + ---***--- + Start... + 1 Mississippi, + 2 Mississippi, + 3 Mississippi, + 4 Mississippi, + 5 Mississippi, + ...}-| + + +@;-------------------------------------------------------------------- +@section{Indentation in Preprocessed output} + +An issue that can be very important in many preprocessor applications +is the indentation of the output. This can be crucial in some cases, +if you're generating code for an indentation-sensitive language (e.g., +Haskell, Python, or C preprocessor directives). To get a better +understanding of how the pieces interact, you may want to review how +the @seclink["reader"]|{Scribble reader}| section, but also remember +that you can use quoted forms to see how some form is read. + +@example|-{#lang scribble/text + @(format "~s" '@list{ + a + b + c}) + ---***--- + (list "a" "\n" " " "b" "\n" "c")}-| + +The Scribble reader ignores indentation spaces in its body. This is +an intentional feature, since you usually do not want an expression to +depend on its position in the source. But the question is how +@emph{can} we render some output text with proper indentation. The +@scheme[output] function achieves that by assigning a special meaning +to lists: when a newline is part of a list's contents, it causes the +following text to appear with indentation that corresponds to the +column position at the beginning of the list. In most cases, this +makes the output appear ``as intended'' when lists are used for nested +pieces of text --- either from a literal @scheme[list] expression, or +an expression that evaluates to a list, or when a list is passed on as +a value; either as a toplevel expression, or as a nested value; either +appearing after spaces, or after other output. + +@example|-{#lang scribble/text + foo @list{1 + 2 + 3} + ---***--- + foo 1 + 2 + 3}-| + +@example|-{#lang scribble/text + @(define (block . text) + @list{begin + @text + end}) + @block{first + second + @block{ + third + fourth} + last} + ---***--- + begin + first + second + begin + third + fourth + end + last + end}-| + +@example|-{#lang scribble/text + @(define (enumerate . items) + (add-newlines #:sep ";\n" + (for/list ([i (in-naturals 1)] + [item (in-list items)]) + @list{@|i|. @item}))) + Todo: @enumerate[@list{Install PLT Scheme} + @list{Hack, hack, hack} + @list{Profit}]. + ---***--- + Todo: 1. Install PLT Scheme; + 2. Hack, hack, hack; + 3. Profit.}-| + +@example[#:hidden]|-{ + #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 + ---***--- + begin + a + b + c + d + e + f + g + h + i + j + k + l + m + n + o + p + q + end + }-| + +@example[#:hidden]|-{ + #lang scribble/text + + @list{ + a + + b + } + + c + ---***--- + a + + b + + c + }-| + +@example[#:hidden]|-{ + #lang scribble/text + @; indentation works even when coming from a function + @(define (((if . c) . t) . e) + @list{ + if (@c) + @t + else + @e + fi}) + 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 + } + ---***--- + 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 + } + }-| + +@example[#:hidden]|-{ + #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} + ---***--- + function foo() { + prefix + if (1 < 2) + something1 + else + something2 + something3 + something4 + something5 + something6 + something7 + fi + return + } + 123 foo bar1 + bar2 + bar2 + }-| + +There are, however, cases when you need more refined control over the +output. The @scheme[scribble/text] provides a few functions for such +cases. The @scheme[splice] function is used to group together a +number of values but avoid introducing a new indentation context. + +@example|-{#lang scribble/text + @(define (block . text) + @splice{{ + blah(@text); + }}) + start + @splice{foo(); + loop:} + @list{if (something) @block{one, + two}} + end + ---***--- + start + foo(); + loop: + if (something) { + blah(one, + two); + } + end + }-| + +The @scheme[verbatim] function disables all indentation printouts in +its contents, including the indentation before the verbatim value +itself. It is useful, for example, to print out CPP directives. + +@example|-{#lang scribble/text + @(define (((IFFOO . var) . expr1) . expr2) + (define (array e1 e2) + @list{[@e1, + @e2]}) + @list{var @var; + @verbatim{#ifdef FOO} + @var = @array[expr1 expr2]; + @verbatim{#else} + @var = @array[expr2 expr1]; + @verbatim{#endif}}) + + function blah(something, something_else) { + @verbatim{#include "stuff.inc"} + @@@IFFOO{i}{something}{something_else} + } + ---***--- + function blah(something, something_else) { + #include "stuff.inc" + var i; + #ifdef FOO + i = [something, + something_else]; + #else + i = [something_else, + something]; + #endif + } + }-| + +If there are values after a @scheme[verbatim] value on the same line +will, they will get indented to the goal column (unless the output is +already beyond it). + +@example|-{#lang scribble/text + @(define (thunk name . body) + @list{function @name() { + @body + }}) + @(define (ifdef cond then else) + @list{@verbatim{#}ifdef @cond + @then + @verbatim{#}else + @else + @verbatim{#}endif}) + + @thunk['do_stuff]{ + init(); + @ifdef["HAS_BLAH" + @list{var x = blah();} + @thunk['blah]{ + @ifdef["BLEHOS" + @list{@verbatim{#}include + bleh();} + @list{error("no bleh");}] + }] + more_stuff(); + } + ---***--- + function do_stuff() { + init(); + # ifdef HAS_BLAH + var x = blah(); + # else + function blah() { + # ifdef BLEHOS + # include + bleh(); + # else + error("no bleh"); + # endif + } + # endif + more_stuff(); + } + }-| + +There are cases where each line should be prefixed with some string +other than a plain indentation. The @scheme[prefix] function causes +its contents to be printed using some given string prefix for every +line. The prefix gets accumulated to an existing indentation, and +indentation in the contents gets added to the prefix. + +@example|-{#lang scribble/text + @(define (comment . body) + @prefix["// "]{@body}) + @comment{add : int int -> string} + char *foo(int x, int y) { + @comment{ + skeleton: + allocate a string + print the expression into it + @comment{...more work...} + } + char *buf = malloc(@comment{FIXME! + This is bad} + 100); + } + ---***--- + // add : int int -> string + char *foo(int x, int y) { + // skeleton: + // allocate a string + // print the expression into it + // // ...more work... + char *buf = malloc(// FIXME! + // This is bad + 100); + } + }-| + +Trying to combine @scheme[prefix] and @scheme[verbatim] is more useful +using an additional value: @scheme[flush] is bound to a value that +causes @scheme[output] to print the current indentation and prefix. +It makes it possible to get the ``ignored as a prefix'' property of +@scheme[verbatim] but only for a nested prefix. + +@example|-{#lang scribble/text + @(define (comment . text) + (list flush + @prefix[" *"]{ + @verbatim{/*} @text */})) + function foo(x) { + @comment{blah + more blah + yet more blah} + if (x < 0) { + @comment{even more + blah here + @comment{even + nested}} + do_stuff(); + } + } + ---***--- + function foo(x) { + /* blah + * more blah + * yet more blah */ + if (x < 0) { + /* even more + * blah here + * /* even + * * nested */ */ + do_stuff(); + } + } + }-| + +@example[#:hidden]|-{ + #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 + (list flush (prefix "| " (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 + ---***--- + start + * blah blah blah + | blah blah blah + | * more stuff + | | more stuff + | | more stuff + | blah blah blah + | blah blah blah + * more blah + blah blah + end + }-| + + @;-------------------------------------------------------------------- @section{Using External Files} Using additional files that contain code for your preprocessing is -trivial: the preprocessor source is a plain Scheme file, so you can -@scheme[require] additional files as usual. +trivial: the preprocessor source is still source code in a module, so +you can @scheme[require] additional files with utility functions. -However, things can become tricky if you want to include an external -file that should also be preprocessed. Using @scheme[require] with a -text file (that uses the @scheme[scribble/text] language) almost -works, but when a module is required, it is invoked before the current -module, which means that the required file will be preprocessed before -the current file regardless of where the @scheme[require] expression -happens to be. Alternatively, you can use @scheme[dynamic-require] -with @scheme[#f] for the last argument (which makes it similar to a -plain @scheme[load])---but remember that the path will be relative to -the current directory, not to the source file. +@example|-{#lang scribble/text + @(require "itemize.ss") + Todo: + @itemize[@list{Hack some} + @list{Sleep some} + @list{Hack some + more}] + ---***--- itemize.ss + #lang scheme + (provide itemize) + (define (itemize . items) + (add-between (map (lambda (item) + (list "* " item)) + items) + "\n")) + ---***--- + Todo: + * Hack some + * Sleep some + * Hack some + more + }-| -Finally, there is a convenient syntax for including text files to be -processed: +Note that the @seclink["at-exp-lang"]{@scheme[at-exp] language} can +often be useful here, since such files need to deal with texts. Using +it, it is easy to include a lot of textual content. -@defform[(include filename)]{ +@example|-{#lang scribble/text + @(require "stuff.ss") + Todo: + @itemize[@list{Hack some} + @list{Sleep some} + @list{Hack some + more}] + @summary + ---***--- stuff.ss + #lang at-exp scheme/base + (require scheme/list) + (provide (all-defined-out)) + (define (itemize . items) + (add-between (map (lambda (item) + @list{* @item}) + items) + "\n")) + (define summary + @list{If that's not enough, + I don't know what is.}) + ---***--- + Todo: + * Hack some + * Sleep some + * Hack some + more + If that's not enough, + I don't know what is. + }-| -Preprocess the @scheme[filename] using the same syntax as -@scheme[scribble/text]. This is similar to using @scheme[load] in a -namespace that can access names bound in the current file so included -code can refer to bindings from the including module. Note, however, -that the including module cannot refer to names that are bound the -included file because it is still a plain scheme module---for such -uses you should still use @scheme[require] as usual.} +Of course, the extreme side of this will be to put all of your content +in a plain Scheme module, using @"@"-forms for convenience. However, +there is no need to use the preprocessor language in this case; +instead, you can @scheme[(require scribble/text)], which will get all +of the bindings that are available in the @scheme[scribble/text] +language. Using @scheme[output], switching from a preprocessed files +to a Scheme file is very easy ---- choosing one or the other depends +on whether it is more convenient to write a text file with occasional +Scheme expressions or the other way. + +@example|-{#lang at-exp scheme/base + @(require scribble/text scheme/list) + (define (itemize . items) + (add-between (map (lambda (item) + @list{* @item}) + items) + "\n")) + (define summary + @list{If that's not enough, + I don't know what is.}) + @(output + @list{ + Todo: + @itemize[@list{Hack some} + @list{Sleep some} + @list{Hack some + more}] + @summary + }) + ---***--- + Todo: + * Hack some + * Sleep some + * Hack some + more + If that's not enough, + I don't know what is. + }-| + +However, you might run into a case where it is desirable to include a +mostly-text file from a preprocessor file. It might be because you +prefer to split the source text to several files, or because you need +to preprocess a file without even a @litchar{#lang} header (for +example, an HTML template file that is the result of an external +editor). For these cases, the @scheme[scribble/text] language +provides an @scheme[include] form that includes a file in the +preprocessor syntax (where the default parsing mode is text). + + +@example|-{#lang scribble/text + @(require scheme/list) + @(define (itemize . items) + (list + "
    " + (add-between + (map (lambda (item) + @list{
  • @|item|
    • }) + items) + "\n") + "
")) + @(define title "Todo") + @(define summary + @list{If that's not enough, + I don't know what is.}) + + @include["template.html"] + ---***--- template.html + + @|title| + +

@|title|

+ @itemize[@list{Hack some} + @list{Sleep some} + @list{Hack some + more}] +

@|summary|

+ + + ---***--- + + Todo + +

Todo

+
  • Hack some
    • +
  • Sleep some
    • +
  • Hack some + more
+

If that's not enough, + I don't know what is.

+ + + }-| + +(Using @scheme[require] with a text file in the @scheme[scribble/text] +language will not work as intended: using the preprocessor language +means that the text is displayed when the module is invoked, so the +required file's contents will be printed before any of the requiring +module's text does. If you find yourself in such a situation, it is +better to switch to a Scheme-with-@"@"-expressions file as shown +above.) + +@;FIXME: add this to the reference section +@;@defform[(include filename)]{ +@; +@;Preprocess the @scheme[filename] using the same syntax as +@;@scheme[scribble/text]. This is similar to using @scheme[load] in a +@;namespace that can access names bound in the current file so included +@;code can refer to bindings from the including module. Note, however, +@;that the including module cannot refer to names that are bound the +@;included file because it is still a plain scheme module---for such +@;uses you should still use @scheme[require] as usual.} + + +@; Two random tests +@example[#:hidden]|-{ + #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 + ---***--- + 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 + }-| +@example[#:hidden]|-{ + #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{inp1} + + @(let ([name "Eli"]) (let ([foo (include "inp2")]) (list foo "\n" foo))) + Repeating yourself much? + ---***--- inp1 + Warning: blah overdose might be fatal + ---***--- inp2 + @(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. + + ---***--- + --*-- + 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? + }-| diff --git a/collects/scribblings/scribble/utils.ss b/collects/scribblings/scribble/utils.ss index d70962b2..b51fe4d0 100644 --- a/collects/scribblings/scribble/utils.ss +++ b/collects/scribblings/scribble/utils.ss @@ -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")]))) diff --git a/collects/tests/scribble/main.ss b/collects/tests/scribble/main.ss index b1465088..15ba5bbd 100644 --- a/collects/tests/scribble/main.ss +++ b/collects/tests/scribble/main.ss @@ -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))