syntax colorer support for the custom command character.

info.rkt

@@ -12,7 +12,8 @@
                "sexp-diff"
                "tr-immutable"
                "typed-map-lib"
-               "debug-scopes"))
+               "debug-scopes"
+               "syntax-color-lib"))
 (define build-deps '("scribble-lib"
                      "racket-doc"
                      "rackunit-doc"

lang/first-line-utils.rkt

@@ -3,7 +3,9 @@
 (require racket/port)
 
 (provide read-whole-first-line
-         read-syntax-whole-first-line)
+         read-syntax-whole-first-line
+         narrow-to-one-line
+         read-line-length)
 
 (define (read-line-length port)
   (let* ([peeking (peeking-input-port port)]

lang/meta-first-line.rkt

@@ -10,7 +10,8 @@
          "../comments/hide-comments.rkt")
 
 (provide meta-read-inside
-         meta-read-syntax-inside)
+         meta-read-syntax-inside
+         get-command-char)
 
 (define (make-at-reader+comments #:syntax? [syntax? #t]
                                  #:inside? [inside? #f]
@@ -26,7 +27,7 @@
                         #:unsyntax #f))))
 
 (define (get-command-char rd1)
-  (define rd1-datum (if (syntax? rd1) (syntax->datum rd1) rd1))
+  (define rd1-datum (syntax->datum (datum->syntax #f rd1)))
   (if (and (pair? rd1-datum)
            (keyword? (car rd1-datum))
            (= 1 (string-length (keyword->string (car rd1-datum)))))

lang/reader.rkt

@@ -9,7 +9,7 @@ hyper-literate/lang
 ;; don't use scribble-base-info for the #:info arg, since
 ;; scribble/lp files are not directly scribble'able.
 #:language-info (scribble-base-language-info)
-#:info orig-scribble-base-reader-info ;(wrapped-scribble-base-reader-info)
+#:info (wrapped-scribble-base-reader-info)
 (require "meta-first-line.rkt"
          (only-in scribble/base/reader
                   scribble-base-reader-info
@@ -19,19 +19,61 @@ hyper-literate/lang
 (define orig-scribble-base-reader-info
   (scribble-base-reader-info))
 
+(require syntax-color/scribble-lexer
+         syntax-color/racket-lexer
+         racket/port)
+
 (define (wrapped-scribble-base-reader-info)
+  (define (read/at-exp in offset x-mode)
+    (define-values (mode2 lexr command-char mode)
+      (apply values x-mode))
+
+    (define-values (r1 r2 r3 r4 r5 max-back-up new-mode)
+      (lexr in offset mode))
+    (define new-x-mode (list 'main lexr command-char new-mode))
+
+    (values r1 r2 r3 r4 r5 max-back-up new-x-mode))
+
+  (define (make-lexr command-char)
+    (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)
+      (apply values x-mode))
+
+    (define-values (txt type paren start end) (racket-lexer in))
+    ;; TODO: limit the number of newlines to a single newline.
+    (if (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 ()
+          (define new-command-char
+            (or command-char
+                (if (memq type '(comment sexp-comment white-space))
+                    #f
+                    (if (eq? type 'hash-colon-keyword)
+                        (let ([rd (read (open-input-string txt))])
+                          (if (and (keyword? rd)
+                                   (= (string-length (keyword->string rd)) 1))
+                              (string-ref (keyword->string rd) 0)
+                              #\@))
+                        #\@))))
+          (values txt type paren start end
+                  0 (list 'options new-command-char)))))
+  
   (lambda (key defval default)
     (case key
       [(color-lexer)
-       (let ([lexr (orig-scribble-base-reader-info key defval default)])
-         (let ([first? #t])
-           (λ (in offset mode)
-             (when first?
-               (set! first? #f)
-               ;; TODO: should return (values "#:opt" 'hash-colon-keyword …) for
-               ;; the options
-               (read-syntax-whole-first-line (object-name in) in))
-             ;; Note that offset and mode are optional
-             (lexr in offset mode))))]
+       (λ (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))]
+           [(eq? (car x-mode) 'options)
+            (read/options in offset x-mode)]
+           [else
+            (read/at-exp in offset x-mode)]))]
       [else
        (orig-scribble-base-reader-info key defval default)])))