Allow the last expresion of the lang-line to span multiple lines. Stop providing #%top-interaction, so that one from the user's language is used instead (still can't access the bindings without providing them + (require (submod .)), but it's a step forward)

lang.rkt

@@ -5,4 +5,4 @@
 (provide (rename-out [module-begin/doc #%module-begin])
          ;; TODO: this is the #%top-interaction from racket/base, not from the
          ;; user-specified language.
-         #%top-interaction)
+         #;#%top-interaction)

lang/first-line-utils.rkt

@@ -18,12 +18,35 @@
   (make-limited-input-port port (read-line-length port)))
 
 (define (read-*-whole-first-line rec-read in)
-  (define in1 (narrow-to-one-line in))
+  (define in1 (peeking-input-port (narrow-to-one-line in)))
-  (let loop ([res '()])
+  
-    (define res+ (rec-read in1))
+  (define start-pos (file-position in1))
-    (if (eof-object? res+)
+
-        (reverse res)
+  (let loop ([last-good-pos start-pos])
-        (loop (cons res+ res)))))
+    (define res+
+      ;; Try to read (may fail if the last object to read spills onto the next
+      ;; lines. We read from the peeking-input-port, so that we can retry the
+      ;; last read on the full, non-narrowed port.
+      (with-handlers ([exn:fail:read? (λ (_) 'read-error)])
+        (list (rec-read in1))))
+    (cond
+      [(eq? res+ 'read-error)
+       ;; Last read was unsuccessful, only consume the bytes from the original
+       ;; input port up to the last successful read. Then, re-try one last read
+       ;; on the whole file (i.e. the last read object may span several lines).
+       (read-bytes (- last-good-pos start-pos) in)
+       (list (rec-read in))]
+      [(eof-object? (car res+))
+       ;; Last successful read, actually consume the bytes from the original
+       ;; input port. Technically, last-good-pos and (file-position pk) should
+       ;; be the same, since the last read returned #<eof> (and therefore did
+       ;; not advance the read pointer.
+       (read-bytes (- (file-position in1) start-pos) in)
+       '()]
+      [else
+       ;; One successful read. Prepend it, and continue reading some more.
+       (cons (car res+)
+             (loop (file-position in1)))])))
 
 (define (read-whole-first-line in)
   (read-*-whole-first-line (λ (in1) (read in1)) in))

lang/reader.rkt

@@ -38,14 +38,23 @@ hyper-literate/lang
     (make-scribble-inside-lexer #:command-char (or command-char #\@)))
   
   (define (read/options in offset x-mode)
-    (define-values (line column position) (port-next-location in))
+    (define-values (mode2 command-char depth)
-    (define-values (mode2 command-char)
       (apply values x-mode))
 
-    (define-values (txt type paren start end) (racket-lexer in))
+    (define-values (txt type paren start end status) (racket-lexer/status in))
+    (define new-depth (case status
+                        [(open) (add1 depth)]
+                        [(close) (sub1 depth)]
+                        [else depth]))
     ;; TODO: limit the number of newlines to a single newline.
-    (if (and (eq? type 'white-space)
+    (if (or
-             (regexp-match #px"\n" txt))
+         ;; Fallback to scribble mode fast if we get a close-paren too many.
+         ;; This could be because the text starts right after the last "config"
+         ;; expression (which would start on the first line, then continue).
+         (< new-depth 0)
+         (and (= new-depth 0)
+              (and (eq? type 'white-space)
+                   (regexp-match #px"\n" txt))))
         (values txt type paren start end
                 0 (list 'main (make-lexr command-char) command-char #f))
         (let ()
@@ -61,16 +70,15 @@ hyper-literate/lang
                               #\@))
                         #\@))))
           (values txt type paren start end
-                  0 (list 'options new-command-char)))))
+                  0 (list 'options new-command-char new-depth)))))
   
   (lambda (key defval default)
     (case key
       [(color-lexer)
        (λ (in offset x-mode)
-         (define-values (line column position) (port-next-location in))
          (cond
            [(eq? x-mode #f)
-            (read/options in offset (list 'options #f))]
+            (read/options in offset (list 'options #f 0))]
            [(eq? (car x-mode) 'options)
             (read/options in offset x-mode)]
            [else

private/common.rkt

@@ -179,8 +179,7 @@
     [(_modbeg {~or (lang:id
                     {~optional (~and no-require-lang #:no-require-lang)}
                     {~optional (~and no-auto-require #:no-auto-require)})
-                   ({~optional (~and no-require-lang #:no-require-lang)}
+                   ({~optional (~and no-auto-require #:no-auto-require)}
-                    {~optional (~and no-auto-require #:no-auto-require)}
                     (lang:id
                      . chain₊))}
               body0 . body)

private/lp.rkt

@@ -128,6 +128,9 @@
        ;; TODO: hash tables
        [else e]))
 
+(define-for-syntax (prettify-chunk-name str)
+  (regexp-replace #px"^<(.*)>$" str "«\\1»"))
+
 (define-for-syntax ((make-chunk-display racketblock unsyntax-id) stx)
   (syntax-parse stx
     ;; no need for more error checking, using chunk for the code will do that
@@ -145,6 +148,7 @@
      (define n-repeat (get+increment-repeat-chunk-number!
                        original-name:n))
      (define str (symbol->string (syntax-e #'name)))
+     (define str-display (prettify-chunk-name str))
      (define/with-syntax tag (format "chunk:~a:~a:~a" str n n-repeat))
      (define/with-syntax (rest ...)
        ;; if the would-be-next number for this chunk name is "2", then there is
@@ -178,11 +182,12 @@
                 (list (elemtag '(prefixable tag)
                                (bold (italic (elemref '(prefixable tag)
                                                       #:underline? #f
-                                                      #,str rest ...))
+                                                      #,str-display rest ...))
                                      " ::=")))
                 (list (smaller
                        (make-link-element "plainlink"
-                                          (decode-content (list #,str rest ...))
+                                          (decode-content
+                                           (list #,str-display rest ...))
                                           `(elem (prefixable
                                                   ,@(chunks-toc-prefix)
                                                   tag))))))
@@ -274,8 +279,8 @@
     [(_ id)
      (identifier? #'id)
      (with-syntax ([tag (format "chunk:~a:1:1" (syntax-e #'id))]
-                   [str (format "~a" (syntax-e #'id))])
+                   [pretty (prettify-chunk-name (format "~a" (syntax-e #'id)))])
-       #'(elemref '(prefixable tag) #:underline? #f str))]))
+       #'(elemref '(prefixable tag) #:underline? #f pretty))]))
 
 
 (provide (all-from-out scheme/base