commit 0f0d662b1483ea488cc0fe583e14eb540673c934
parent bbbd68b3c229728c01da2bddf5a6dce140fe9485
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 30 Dec 2015 07:22:15 -0600
scribble/lp2: strip `code:comment`, etc.
Diffstat:
4 files changed, 70 insertions(+), 10 deletions(-)
diff --git a/scribble-doc/scribblings/scribble/lp.scrbl b/scribble-doc/scribblings/scribble/lp.scrbl
@@ -79,7 +79,7 @@ with @racket[module*].
chunks. Normally, @racket[id] starts with @litchar{<} and ends with
@litchar{>}.
- When running a scribble program only the code inside the
+ When running the enclosing program, only the code inside the
chunks is run; the rest is ignored.
If @racket[id] is @racketidfont{<*>}, then this chunk is
@@ -90,13 +90,18 @@ with @racket[module*].
the main chunk references), then it is not included in the
program and thus is not run.
-}
+ The @racket[form]s are typeset using @racket[racketblock], so
+ @racket[code:comment], etc., can be used to adjust the output.
+ Those output-adjusting forms are stripped from each @racket[form]
+ for running the program.
+
+@history[#:changed "1.17" @elem{Strip @racket[code:comment], etc., for running.}]}
@defform[(CHUNK id form ...)]{
- Like @racket[chunk], but allows the use of @racket[unsyntax] in the
-code part. If you want to use @racket[unsyntax] to escape to Scribble,
-use @racket[UNSYNTAX].
+ Like @racket[chunk], but typesets with @racket[RACKETBLOCK], so @racket[unsyntax]
+ can be used normally in each @racket[form]. To escape,
+ use @racket[UNSYNTAX].
}
diff --git a/scribble-lib/scribble/lp/lang/common.rkt b/scribble-lib/scribble/lp/lang/common.rkt
@@ -29,9 +29,8 @@
(define-syntax (tangle stx)
(define chunk-mentions '())
- (define stupid-internal-definition-sytnax
- (unless first-id
- (raise-syntax-error 'scribble/lp "no chunks")))
+ (unless first-id
+ (raise-syntax-error 'scribble/lp "no chunks"))
(define orig-stx (syntax-case stx () [(_ orig) #'orig]))
(define (restore nstx d) (datum->syntax orig-stx d nstx nstx))
(define (shift nstx) (replace-context orig-stx nstx))
@@ -52,8 +51,8 @@
(if subs
(list (restore expr (loop subs)))
(list (shift expr))))))
- block)))))
- (with-syntax ([(body ...) body]
+ block)))))
+ (with-syntax ([(body ...) (strip-comments body)]
;; construct arrows manually
[((b-use b-id) ...)
(append-map (lambda (m)
@@ -64,6 +63,48 @@
chunk-mentions)])
#`(begin body ... (let ([b-id (void)]) b-use) ...)))
+(define-for-syntax (strip-comments body)
+ (cond
+ [(syntax? body)
+ (define r (strip-comments (syntax-e body)))
+ (if (eq? r (syntax-e body))
+ body
+ (datum->syntax body r body body))]
+ [(pair? body)
+ (define a (car body))
+ (define ad (syntax-e a))
+ (cond
+ [(and (pair? ad)
+ (memq (syntax-e (car ad))
+ '(code:comment
+ code:contract)))
+ (strip-comments (cdr body))]
+ [(eq? ad 'code:blank)
+ (strip-comments (cdr body))]
+ [(and (or (eq? ad 'code:hilite)
+ (eq? ad 'code:quote))
+ (let* ([d (cdr body)]
+ [dd (if (syntax? d)
+ (syntax-e d)
+ d)])
+ (and (pair? dd)
+ (or (null? (cdr dd))
+ (and (syntax? (cdr dd))
+ (null? (syntax-e (cdr dd))))))))
+ (define d (cdr body))
+ (define r
+ (strip-comments (car (if (syntax? d) (syntax-e d) d))))
+ (if (eq? ad 'code:quote)
+ `(quote ,r)
+ r)]
+ [(and (pair? ad)
+ (eq? (syntax-e (car ad))
+ 'code:line))
+ (strip-comments (append (cdr ad) (cdr body)))]
+ [else (cons (strip-comments a)
+ (strip-comments (cdr body)))])]
+ [else body]))
+
(define-for-syntax (extract-chunks exprs)
(let loop ([exprs exprs])
(syntax-case exprs ()
diff --git a/scribble-test/tests/scribble/docs/lp-comment.scrbl b/scribble-test/tests/scribble/docs/lp-comment.scrbl
@@ -0,0 +1,8 @@
+#lang scribble/lp2
+
+@chunk[<%>
+ (code:contract f : number -> number)
+ 1 (code:comment "The number 1")
+ code:blank
+ (code:line (code:hilite 2) (code:quote 3))
+]
diff --git a/scribble-test/tests/scribble/docs/lp-comment.txt b/scribble-test/tests/scribble/docs/lp-comment.txt
@@ -0,0 +1,6 @@
+<%> ::=
+
+ ; f : number -> number
+ 1 ; The number 1
+
+ 2 (quote 3)
