A version of scribble-block to do escapes but still permit definition.

revised-scribble-block.rkt

#lang scribble/base

@;; Submodule to provide support for a "block"-like form for Scribble documents.
@;;
@;; Adapted from racket/block
@;;
@;; The subexpressions are all collected into a list.
@;; Perhaps something like this belongs in the scribble library?
@(module scribble-block racket/base

   (require (for-syntax racket/base
                        syntax/stx))
   (provide scribble-block)
   
   (define-values-for-syntax (make-context)
     (let-values ([(struct: mk ? ref set)
                   (make-struct-type 'in-liberal-define-context #f 0 0 #f
                                     (list (cons prop:liberal-define-context #t)))])
       mk))
   
   (define-syntax (scribble-block stx)
     ;; Body can have mixed exprs and defns. Wrap expressions with
     ;; `(define-values () ... (values))' as needed, and add a (void)
     ;; at the end if needed.
     (let* ([def-ctx (syntax-local-make-definition-context)]
            [ctx (list (make-context))]
            ;; [kernel-forms (kernel-form-identifier-list)]
            [stoplist (list #'begin #'define-syntaxes #'define-values)]
            [init-exprs (let ([v (syntax->list stx)])
                          (unless v (raise-syntax-error #f "bad syntax" stx))
                          (cdr v))]
            [exprs
             (let loop ([todo init-exprs] [r '()])
               (if (null? todo)
                   (reverse r)
                   (let ([expr (local-expand (car todo) ctx stoplist def-ctx)]
                         [todo (cdr todo)])
                     (syntax-case expr (begin define-syntaxes define-values)
                       [(begin . rest)
                        (loop (append (syntax->list #'rest) todo) r)]
                       [(define-syntaxes (id ...) rhs)
                        (andmap identifier? (syntax->list #'(id ...)))
                        (with-syntax ([rhs (local-transformer-expand
                                            #'rhs 'expression null)])
                          (syntax-local-bind-syntaxes
                           (syntax->list #'(id ...))
                           #'rhs def-ctx)
                          (loop todo (cons #'(define-syntaxes (id ...) rhs) r)))]
                       [(define-values (id ...) rhs)
                        (andmap identifier? (syntax->list #'(id ...)))
                        (let ([ids (syntax->list #'(id ...))])
                          (syntax-local-bind-syntaxes ids #f def-ctx)
                          (loop todo (cons expr r)))]
                       [else (loop todo (cons expr r))]))))])
       (internal-definition-context-seal def-ctx)
       (let loop ([exprs exprs]
                  [prev-stx-defns null]
                  [prev-defns null]
                  [prev-exprs null])
         (cond
           [(null? exprs)
            #`(letrec-syntaxes+values
                  #,(map stx-cdr (reverse prev-stx-defns))
                #,(map stx-cdr (reverse prev-defns))
                #,@(if (null? prev-exprs)
                       (list #'(void))
                       (list #`(list #,@(reverse prev-exprs)))))]
           [(and (stx-pair? (car exprs))
                 (identifier? (stx-car (car exprs)))
                 (free-identifier=? #'define-syntaxes (stx-car (car exprs))))
            (loop (cdr exprs)
                  (cons (car exprs) prev-stx-defns)
                  prev-defns
                  prev-exprs)]
           [(and (stx-pair? (car exprs))
                 (identifier? (stx-car (car exprs)))
                 (free-identifier=? #'define-values (stx-car (car exprs))))
            (loop (cdr exprs)
                  prev-stx-defns
                  (cons (car exprs)
                        (append
                         (map (lambda (expr)
                                #`(define-values () (begin #,expr (values))))
                              prev-exprs)
                         prev-defns))
                  null)]
           [else (loop (cdr exprs)
                       prev-stx-defns
                       prev-defns
                       (cons (car exprs) prev-exprs))])))))

@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@;; Let's try using it:   
   
@(require (submod "." scribble-block))

@title{Larger example}


@; Everything within the following will be escaped.  use |^ to unescape.
@scribble-block|^{


|^@;; Note that the definition here is good in the context of the block.
|^@;;
|^@(define (double x)
     (list x x))
   

this is an example with @ signs in it.  I can still
use @ by using it like this: |^@tt{Hello world}, right?


Let's try another paragraph.

|^@section{Section one}
This is a first section with @ signs in it.


|^@section{Section two}
Here is another section with @ signs.  We can still
call functions like this: |^@double{@double{quad}}.

}^|