scribble/lp2: strip code:comment, etc.

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].
 
 }
 

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 ()

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))
+]

scribble-test/tests/scribble/docs/lp-comment.txt

@@ -0,0 +1,6 @@
+<%> ::=
+
+  ; f : number -> number
+  1 ; The number 1      
+                        
+  2 (quote 3)