add function for convenience in working with scribble

udelim/main.rkt

@@ -12,6 +12,7 @@
   [make-list-delim-readtable/wrap
    (->* (char? char? symbol?) (#:base-readtable readtable?) readtable?)]
   [stx-string->port (->* (syntax?) input-port?)]
+  [scribble-strings->string (->* (syntax?) syntax?)]
   ))
 
 (require syntax/readerr)
@@ -127,6 +128,46 @@
           (set-port-next-location! p line col pos)
           p))))
 
+(define (reconstitute-scribble-strings stx)
+  ;; Based on `verb` macro in reader-internals docs.
+  ;; If there is a newline after the opening brace, it doesn't
+  ;; seem to show up, still.  Oh well.
+  (syntax-case stx ()
+    [(item ...)
+     (datum->syntax
+      stx
+      (let loop ([items (syntax->list #'(item ...))])
+        (if (null? items)
+            '()
+            (let* ([fst  (car items)]
+                   [prop (syntax-property fst 'scribble)]
+                   [rst  (loop (cdr items))])
+              (cond [(not prop) (cons fst rst)]
+                    [(eq? prop 'indentation) rst]
+                    [(not (and (pair? prop)
+                               (eq? (car prop) 'newline)))
+                     (cons fst rst)]
+                    [else (cons (datum->syntax
+                                 fst (cadr prop) fst)
+                                rst)])))))]))
+
+(define (scribble-strings->string stx)
+  (syntax-case stx ()
+    [(arg ...)
+     (let* ([error-if-not-str (λ (s) (or (string? (syntax->datum s))
+                                         (raise-syntax-error 'scribble-strings->string
+                                                             "expected string"
+                                                             s)))]
+            [all-strs? (map error-if-not-str (syntax->list stx))]
+            [one-str (apply string-append
+                            (map syntax->datum
+                                 (syntax->list
+                                  (reconstitute-scribble-strings #'(arg ...)))))]
+            [s (car (syntax->list #'(arg ...)))]
+            [loclist (list (syntax-source s) (syntax-line s) (syntax-column s)
+                           (syntax-position s) (string-length one-str))])
+       (datum->syntax s one-str loclist))]))
+
 (module+ test
   (require rackunit)
 

udelim/udelim.scrbl

@@ -109,6 +109,38 @@ When you use @racket[read-syntax] on the resulting port, the syntax objects will
 
 }
 
+@defproc[(scribble-strings->string [stx syntax?]) syntax?]{
+Takes a syntax object that represents a list of strings created by the scribble reader, and reconstitutes them into one string.  If the syntax contains anything that is not a string, it raises an error.
+
+This makes it easier for a sub-parsing macro to accept input either from the scribble reader or from a string (including the wonderful verbatim strings with nestable delimiters made with @racket[make-string-delim-readtable]).
+
+Example:
+@codeblock{
+(require (for-syntax udelim syntax/strip-context syntax/parse))
+
+;; this function likely exists somewhere...
+(define-for-syntax (read-syntax* src in)
+  (define (rec rlist)
+    (let ([part (read-syntax src in)])
+      (if (eof-object? part)
+          (reverse rlist)
+          (rec (cons part rlist)))))
+  (rec '()))
+
+(define-syntax (subparse stx)
+  (syntax-parse stx
+    [(subparse arg:str)
+     (with-syntax ([(parg ...) (map (λ (s) (replace-context #'arg s))
+                                     (read-syntax* (syntax-source #'arg)
+                                                   (stx-string->port #'arg)))])
+       #'(begin parg ...))]
+    [(subparse arg:str ...+)
+     (with-syntax ([one-str (scribble-strings->string #'(arg ...))])
+       #'(subparse one-str))]))
+}
+
+}
+
 @section{Code and License}
 
 The code is available