Update 'definition-text-surrogate to accept lists

drracket/drracket/private/in-irl-namespace.rkt

@@ -14,6 +14,7 @@
          get-read-language-last-position/inside
          get-read-language-name/inside
          get-insulated-module-lexer/inside
+         get-definitions-text-surrogate-list/inside
          get-definitions-text-surrogate/inside
          get-submit-predicate/inside
          set-irl-mcli-vec!/inside
@@ -49,6 +50,33 @@
     (set! module-lexer (waive-option (dynamic-require 'syntax-color/module-lexer 'module-lexer))))
   module-lexer)
 
+(define (get-definitions-text-surrogate-list/inside)
+  (define surrogate-modules
+    (and language-get-info
+         (or
+          (add-contract 'definitions-text-surrogate-list
+                        (key->contract 'definitions-text-surrogate-list)
+                        (language-get-info 'definitions-text-surrogate-list #f)))))
+  (or
+   (and surrogate-modules
+        (not (null? surrogate-modules))
+        (new (let* ([surrogate-modules (reverse surrogate-modules)])
+               (for/fold ([base (add-contract 'definitions-text-surrogate-list
+                                              (implementation?/c
+                                               (dynamic-require 'framework 'racket:text-mode<%>))
+                                              (dynamic-require (car surrogate-modules) 'surrogate%))])
+                         ([mix (in-list (cdr surrogate-modules))])
+                 (define mixin
+                   (add-contract 'definitions-text-surrogate-list
+                                 (->
+                                  (implementation?/c
+                                   (dynamic-require 'framework 'racket:text-mode<%>))
+                                  (implementation?/c
+                                   (dynamic-require 'framework 'racket:text-mode<%>)))
+                                 (dynamic-require mix 'surrogate%)))
+                 (mixin base)))))
+   (get-definitions-text-surrogate/inside)))
+
 (define (get-definitions-text-surrogate/inside)
   (define surrogate-module
     (and language-get-info
@@ -152,6 +180,7 @@
 (define (key->contract key)
   (case key
     [(definitions-text-surrogate) (or/c #f module-path?)]
+    [(definitions-text-surrogate-list) (or/c #f (listof module-path?))]
     [(color-lexer)
      ;; the contract here is taken care of inside module-lexer
      any/c]

drracket/drracket/private/insulated-read-language.rkt

@@ -37,7 +37,8 @@ Will not work with the definitions text surrogate interposition that
         'drscheme:opt-out-toolbar-buttons
         'drracket:opt-in-toolbar-buttons
         'color-lexer
-        'definitions-text-surrogate))
+        'definitions-text-surrogate
+        'definitions-text-surrogate-list))
 
 (provide
  (contract-out
@@ -68,6 +69,7 @@ Will not work with the definitions text surrogate interposition that
 
   [get-insulated-module-lexer (-> irl? (procedure-arity-includes/c 3))]
   [get-definitions-text-surrogate (-> irl? (or/c object? #f))]
+  [get-definitions-text-surrogate-list (-> irl? (or/c object? #f))]
 
   [set-irl-mcli-vec! (-> irl? (or/c mcli? #f) void?)]
   [get-insulated-submit-predicate (-> irl? (or/c #f (procedure-arity-includes/c 2)))]
@@ -126,6 +128,11 @@ Will not work with the definitions text surrogate interposition that
                  (λ () #f)
                  'get-definitions-text-surrogate/inside))
 
+(define (get-definitions-text-surrogate-list an-irl)
+  (call-irl-proc an-irl
+                 (λ () #f)
+                 'get-definitions-text-surrogate-list/inside))
+
 (define mcli? (vector/c module-path? symbol? any/c #:flat? #t))
 (define (get-insulated-submit-predicate an-irl)
   (define submit-predicate

drracket/drracket/private/module-language-tools.rkt

@@ -308,7 +308,7 @@
 
         (clear-things-out)
 
-        (define mode (or (get-definitions-text-surrogate the-irl)
+        (define mode (or (get-definitions-text-surrogate-list the-irl)
                          (new racket:text-mode%)))
         (send mode set-get-token (get-insulated-module-lexer the-irl))
         (set-surrogate mode)

drracket/drracket/tool-lib.rkt

@@ -1167,7 +1167,8 @@ all of the names in the tools library, for use defining keybindings
     Note that the @racket[_surrogate] field of the
     mode corresponding to the module language does not
     take into account the 
-    @language-info-ref[definitions-text-surrogate], so it
+    @language-info-ref[definitions-text-surrogate] or the
+    @language-info-ref[definitions-text-surrogate-list], so it
     may not be the actual class used directly in DrRacket,
     even when the mode is active.
 

drracket/scribblings/tools/lang-tools.scrbl

@@ -255,18 +255,34 @@ easily controlled in the case of errors, using the
 definitions text surrogate only until that more easily
 controlled extension has been added to DrRacket.
 
-@language-info-def[definitions-text-surrogate]{ DrRacket
- calls @racket[read-language]'s @racket[get-info] procedure
- with @racket['definitions-text-surrogate] and expects it to
+@language-info-def[definitions-text-surrogate-list]{
+ DrRacket calls @racket[read-language]'s @racket[get-info]
+ procedure with @racket['definitions-text-surrogate-list] and
+ expects it to return a value matching the contract
+ @racket[(or/c #f (listof module-path?))]; each element is
+ also passed to @racket[dynamic-require] with
+ @racket['surrogate%]. The last element must provide a class
+ implementing the interface @racket[racket:text-mode<%>]
+ (presumably derived from @racket[racket:text-mode%]. The
+ remaining elements provide mixins that return a class
+ implementing the @racket[racket:text-mode<%>] interface.
+ DrRacket traverses this list to generate the surrogate for
+ the definitions text. That mode is installed into the
+ definitions text, where it can change its behavior by
+ changing how is responds to any of the methods in the mode.}
+
+@language-info-def[definitions-text-surrogate]{ If
+ @language-info-ref[definitions-text-surrogate] returns
+ @racket[#f] then DrRacket tries
+ @racket['definitions-text-surrogate] and expects it to
  return a value matching the contract
- @racket[(or/c #f module-path?)], which is then passed to
+ @racket[(or/c #f module-path?)], which is is then passed to
  @racket[dynamic-require] together with @racket['surrogate%].
  The result is expected to be a class implementing the
- interface @racket[racket:text-mode<%>] (presumably
- derived from @racket[racket:text-mode%]. That mode is
- installed into the definitions text, where it can change its
- behavior by changing how is responds to any of the methods
- in the mode. }
+ interface @racket[racket:text-mode<%>] (presumably derived
+ from @racket[racket:text-mode%]. That mode is installed into
+ the definitions text, where it can change its behavior by
+ changing how is responds to any of the methods in the mode.}
 
 One consequence of this power is that errors that happen
 during the dynamic extent of calls into the mode are not