change the option setup: everyone has an option contract now and

the module lexer either exercises or not, depending on its level of trust

collects/syntax-color/module-lexer.rkt

@@ -1,8 +1,11 @@
 #lang racket/base
 (require racket/port
          "racket-lexer.rkt"
-         racket/contract)
+         "lexer-contract.rkt"
-(provide module-lexer)
+         racket/contract
+         unstable/options)
+(provide 
+ (contract-out [module-lexer lexer/c]))
 
 #|
 
@@ -23,31 +26,6 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
 
 |#
 
-(define lexer/c
-  (or/c (->i ([in input-port?])
-             (values [txt any/c]
-                     [type symbol?]
-                     [paren (or/c symbol? #f)]
-                     [start (or/c exact-positive-integer? #f)]
-                     [end (start) 
-                          (if start
-                              (and/c exact-positive-integer?
-                                     (>=/c start))
-                              #f)]))
-        (->i ([in input-port?]
-              [offset exact-nonnegative-integer?]
-              [mode any/c])
-            (values [txt any/c]
-                    [type symbol?]
-                    [paren (or/c symbol? #f)]
-                    [start (or/c exact-positive-integer? #f)]
-                    [end (start) 
-                         (if start
-                             (and/c exact-positive-integer?
-                                    (>=/c start))
-                             #f)]
-                    [backup exact-nonnegative-integer?]
-                    [new-mode any/c]))))
 
 (define (module-lexer in offset mode)
   (cond
@@ -91,16 +69,12 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
            (for ([i (in-range (file-position in) (file-position p))])
              (read-byte-or-special in))
            
-           (define no-ctc-lexer (or (get-info 'color-lexer #f)
+           (define the-lexer (or (get-info 'color-lexer #f) racket-lexer))
-                                    racket-lexer))
+           (when (has-option? the-lexer)
-           ;; add the lexer contract
+             (set! the-lexer 
-           (define the-lexer (contract lexer/c
+                   (if (trusted-lexer? the-lexer)
-                                       no-ctc-lexer
+                       (waive-option the-lexer)
-                                       lang-name
+                       (exercise-option the-lexer))))
-                                       'syntax-color/module-lexer
-                                       (or (object-name no-ctc-lexer)
-                                           (format "~a's lexer" lang-name))
-                                       #'here))
            
            ;; Produce language as first token:
            (values
@@ -144,3 +118,12 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
 (define (set-port-next-location-from src dest)
   (define-values (line col pos) (port-next-location src))
   (set-port-next-location! dest line col pos))
+
+
+(define (trusted-lexer? the-lexer)
+  (member (object-name the-lexer)
+          '(racket-lexer 
+            racket-lexer/status 
+            racket-nobar-lexer/status
+            scribble-inside-lexer
+            scribble-lexer)))

collects/syntax-color/racket-lexer.rkt

@@ -1,11 +1,15 @@
 #lang racket/base
 
   (require parser-tools/lex
+           racket/contract
+           "lexer-contract.rkt"
            (prefix-in : parser-tools/lex-sre))
   
-  (provide racket-lexer
+  (provide 
-           racket-lexer/status
+   (contract-out
-           racket-nobar-lexer/status)
+    [racket-lexer lexer/c]
+    [racket-lexer/status lexer/c]
+    [racket-nobar-lexer/status lexer/c]))
    
   (define-lex-abbrevs
          

collects/syntax-color/scribble-lexer.rkt

@@ -1,9 +1,13 @@
 #lang scheme/base
 (require "scheme-lexer.rkt"
+         racket/contract
+         "lexer-contract.rkt"
          racket/port)
 
-(provide scribble-inside-lexer
+(provide 
-         scribble-lexer)
+ (contract-out
+  [scribble-inside-lexer lexer/c]
+  [scribble-lexer lexer/c]))
 
 (define-struct text (scheme-rx end-rx sub-rx string-rx open-paren close-paren) #:transparent)
 (define-struct scheme (status backup) #:transparent)