[plt-scheme] Scribble "SCHEMEBLOCK" that doesn't interpret Scribble markup

First, thanks, Matthew and Robby.

Robby Findler wrote at 02/24/2009 09:07 PM:
> You have Scheme code lying around in strings? (I'm not meaning to be
> nosy here...)
>   

Yes.  Legacy embedded documentation language.  Source file like:

http://planet.plt-scheme.org/package-source/neil/webscraperhelper.plt/1/1/webscraperhelper.ss

Turns into:

http://planet.plt-scheme.org/package-source/neil/webscraperhelper.plt/1/1/planet-docs/webscraperhelper/index.html

You can see the problematic "@" signs in the Scheme code, for which I 
kludged up the below filter just now.  This whole setup (before it gets 
to Scribble, I mean) is kludge atop kludge, while I wait for the right 
*new* embedded documentation format.

(define (filter-scheme-code-escaping-for-scribble in out)
  ;; Note: "done" call should always be in the tail position anyway.
  (let/ec done
    (let in-normal ((c (read-char in)))
      (if (eof-object? c)
          (done)
          (case c

            ((#\@)
             (display "\\@" out)
             (in-normal (read-char in)))

            ((#\")
             (write-char c out)
             (let in-string ((c (read-char in)))
               (if (eof-object? c)
                   (done)
                   (case c

                     ((#\\)
                      (write-char c out)
                      (let ((c (read-char in)))
                        (if (eof-object? c)
                            (done)
                            (begin (write-char c out)
                                   (in-string (read-char in))))))

                     ((#\")
                      (write-char c out)
                      (in-normal (read-char in)))

                     (else (write-char c out)
                           (in-string (read-char in)))))))

            ((#\#)
             (write-char c out)
             (let ((c (read-char in)))
               (if (eof-object? c)
                   (done)
                   (case c

                     ((#\\)
                      (write-char c out)
                      (let ((c (read-char in)))
                        (if (eof-object? c)
                            (done)
                            (case c

                              ((#\" #\@)
                               (write-char c out)
                               (in-normal (read-char in)))

                              (else (in-normal c))))))

                     (else (in-normal c))))))

            (else (write-char c out)
                  (in-normal (read-char in))))))))