add shrubbery/text meta-language

Like `shrubbery` meta-language, but parses the module in `'text` mode.

Resolves racket#612.

rhombus-lib/rhombus/private/core.rkt

@@ -7,13 +7,14 @@
   #:info get-info-proc
   #:whole-body-readers? #t
   (require shrubbery/parse
-           (only-in (submod shrubbery reader)
-                    [get-info-proc shrubbery:get-info-proc]))
+           shrubbery/private/lang)
   (provide get-info-proc)
   (define (get-info-proc key default make-default)
     (case key
-      [(drracket:default-extension) "rhm"]
+      [(drracket:default-extension)
+       "rhm"]
       [(drracket:define-popup)
        (dynamic-require 'rhombus/private/define-popup
                         'define-popup)]
-      [else (shrubbery:get-info-proc key default make-default)])))
+      [else
+       (shrubbery-get-info-proc/mode key default make-default)])))

rhombus-scribble-lib/rhombus/scribble.rkt

@@ -36,8 +36,7 @@
   #:info get-info-proc
   #:whole-body-readers? #t
   (require shrubbery/parse
-           (only-in (submod shrubbery reader)
-                    [get-info-proc shrubbery:get-info-proc]))
+           shrubbery/private/lang)
   (provide read-proc
            read-syntax-proc
            get-info-proc)
@@ -47,15 +46,15 @@
     (list (parse-all in #:mode 'text #:source src)))
   (define (get-info-proc key default make-default)
     (case key
-      [(color-lexer)
-       (dynamic-require 'shrubbery/syntax-color
-                        'shrubbery-text-mode-lexer)]
       [(drracket:keystrokes)
-       (append (shrubbery:get-info-proc key default make-default)
+       (append (shrubbery-get-info-proc/mode key default make-default
+                                             #:mode 'text)
                (dynamic-require 'scribble/private/indentation 'keystrokes))]
       [(drracket:toolbar-buttons)
        (dynamic-require 'scribble/tools/drracket-buttons 'drracket-buttons)]
-      [else (shrubbery:get-info-proc key default make-default)])))
+      [else
+       (shrubbery-get-info-proc/mode key default make-default
+                                     #:mode 'text)])))
 
 (module configure-expand racket/base
   (require rhombus/expand-config)

shrubbery-lib/shrubbery/main.rkt

@@ -1,11 +1,8 @@
 #lang racket/base
 
 (module reader racket/base
-  (require syntax/strip-context
-           syntax/stx
-           "parse.rkt"
-           "private/module-path.rkt")
-
+  (require "private/lang.rkt")
+
   (provide (rename-out [shrubbery-read read]
                        [shrubbery-read-syntax read-syntax])
            get-info
@@ -16,53 +13,11 @@
      (shrubbery-read-syntax #f in)))
 
   (define (shrubbery-read-syntax src in)
-    ;; If there's something on the first line, use that as a module
-    ;; language. Otherwise, just quote. Detect whether there are
-    ;; any newlines by checking the prefix of the first group.
-    (define-values (line col pos) (port-next-location in))
-    (define lang (parse-all in #:mode 'line))
-    (define shrubbery (parse-all in))
-    (strip-context
-     (cond
-       [(and (not (eof-object? lang))
-             (not (stx-null? (stx-cdr lang))))
-        #`(module anything #,(parse-module-path-as-shrubbery lang)
-            #,shrubbery)]
-       [else
-        #`(module anything racket/base
-            '#,shrubbery)])))
+    (shrubbery-read-syntax/mode src in))
 
   (define (get-info in mod line col pos)
     (lambda (key default)
       (get-info-proc key default (lambda (key default) default))))
 
   (define (get-info-proc key default make-default)
-    (case key
-      [(color-lexer)
-       (dynamic-require 'shrubbery/syntax-color
-                        'shrubbery-lexer)]
-      [(drracket:indentation)
-       (dynamic-require 'shrubbery/indentation
-                        'shrubbery-indentation)]
-      [(drracket:range-indentation)
-       (dynamic-require 'shrubbery/indentation
-                        'shrubbery-range-indentation)]
-      [(drracket:paren-matches)
-       (dynamic-require 'shrubbery/indentation
-                        'shrubbery-paren-matches)]
-      [(drracket:quote-matches)
-       (dynamic-require 'shrubbery/indentation
-                        'shrubbery-quote-matches)]
-      [(drracket:grouping-position)
-       (dynamic-require 'shrubbery/navigation
-                        'shrubbery-grouping-position)]
-      [(drracket:submit-predicate)
-       (dynamic-require 'shrubbery/interaction
-                        'shrubbery-submit-predicate)]
-      [(drracket:keystrokes)
-       (dynamic-require 'shrubbery/keystroke
-                        'shrubbery-keystrokes)]
-      [(drracket:comment-delimiters)
-       '((line "//" " ")
-         (region "/*" " *" "*/" " "))]
-      [else (make-default key default)])))
+    (shrubbery-get-info-proc/mode key default make-default)))

shrubbery-lib/shrubbery/private/lang.rkt

@@ -0,0 +1,69 @@
+#lang racket/base
+(require syntax/strip-context
+         syntax/stx
+         "../parse.rkt"
+         "module-path.rkt")
+
+(provide shrubbery-read-syntax/mode
+         shrubbery-get-info-proc/mode)
+
+(define (shrubbery-read-syntax/mode src in
+                                    #:mode [mode 'top])
+  ;; If there's something on the first line, use that as a module
+  ;; language. Otherwise, just quote. Detect whether there are
+  ;; any newlines by checking the prefix of the first group.
+  (define-values (line col pos) (port-next-location in))
+  (define lang (parse-all in #:mode 'line))
+  (define shrubbery (parse-all in #:mode mode #:source src))
+  (define p-name (object-name in))
+  (define module-name
+    (if (path? p-name)
+        (let-values ([(base name dir?) (split-path p-name)])
+          (string->symbol
+           (path->string (path-replace-extension name #""))))
+        'anonymous-module))
+  (strip-context
+   (cond
+     [(and (not (eof-object? lang))
+           (not (stx-null? (stx-cdr lang))))
+      #`(module #,module-name #,(parse-module-path-as-shrubbery lang)
+          #,shrubbery)]
+     [else
+      #`(module #,module-name racket/base
+          '#,shrubbery)])))
+
+(define (shrubbery-get-info-proc/mode key default make-default
+                                      #:mode [mode 'top])
+  (case key
+    [(color-lexer)
+     (dynamic-require 'shrubbery/syntax-color
+                      (case mode
+                        [(top) 'shrubbery-lexer]
+                        [(text) 'shrubbery-text-mode-lexer]
+                        [else (error "invalid mode")]))]
+    [(drracket:indentation)
+     (dynamic-require 'shrubbery/indentation
+                      'shrubbery-indentation)]
+    [(drracket:range-indentation)
+     (dynamic-require 'shrubbery/indentation
+                      'shrubbery-range-indentation)]
+    [(drracket:paren-matches)
+     (dynamic-require 'shrubbery/indentation
+                      'shrubbery-paren-matches)]
+    [(drracket:quote-matches)
+     (dynamic-require 'shrubbery/indentation
+                      'shrubbery-quote-matches)]
+    [(drracket:grouping-position)
+     (dynamic-require 'shrubbery/navigation
+                      'shrubbery-grouping-position)]
+    [(drracket:submit-predicate)
+     (dynamic-require 'shrubbery/interaction
+                      'shrubbery-submit-predicate)]
+    [(drracket:keystrokes)
+     (dynamic-require 'shrubbery/keystroke
+                      'shrubbery-keystrokes)]
+    [(drracket:comment-delimiters)
+     '((line "//" " ")
+       (region "/*" " *" "*/" " "))]
+    [else
+     (make-default key default)]))

shrubbery-lib/shrubbery/text.rkt

@@ -0,0 +1,25 @@
+#lang racket/base
+
+(module reader racket/base
+  (require "private/lang.rkt")
+
+  (provide (rename-out [shrubbery-read read]
+                       [shrubbery-read-syntax read-syntax])
+           get-info
+           get-info-proc)
+
+  (define (shrubbery-read in)
+    (syntax->datum
+     (shrubbery-read-syntax #f in)))
+
+  (define (shrubbery-read-syntax src in)
+    (shrubbery-read-syntax/mode src in
+                                #:mode 'text))
+
+  (define (get-info in mod line col pos)
+    (lambda (key default)
+      (get-info-proc key default (lambda (key default) default))))
+
+  (define (get-info-proc key default make-default)
+    (shrubbery-get-info-proc/mode key default make-default
+                                  #:mode 'text)))

shrubbery/shrubbery/scribblings/language.scrbl

@@ -10,7 +10,7 @@
 
 @title[#:tag "language"]{Language and Parser API}
 
-@defmodulelang[shrubbery]
+@defmodulelang*[(shrubbery shrubbery/text)]
 
 The @racketmodname[shrubbery] meta-language is similar to the
 @racketmodname[s-exp] meta-language. It expects a module name after
@@ -59,6 +59,17 @@ by using @racket[parse-all] in @racket['line] mode. As long as the
 resulting shrubbery is not empty, it is parsed in the same way that
 @racketmodname[rhombus] parses module names for @|rhm-import|.
 
+The @racketmodname[shrubbery/text] meta-language is similar to
+@racketmodname[shrubbery], but it parses the module in @racket['text]
+mode. For example,
+
+@codeblock|{
+ #lang shrubbery/text
+ @(1+2)
+}|
+
+prints @racketresult['(brackets (group (parens (group 1 (op +) 2))))].
+
 @section{Parsing API}
 
 @defmodule[shrubbery/parse]