diff --git a/drracket/drracket/private/in-irl-namespace.rkt b/drracket/drracket/private/in-irl-namespace.rkt index 9ebf41435..039e3e060 100644 --- a/drracket/drracket/private/in-irl-namespace.rkt +++ b/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] diff --git a/drracket/drracket/private/insulated-read-language.rkt b/drracket/drracket/private/insulated-read-language.rkt index 5733006d8..8ef123e5e 100644 --- a/drracket/drracket/private/insulated-read-language.rkt +++ b/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 diff --git a/drracket/drracket/private/module-language-tools.rkt b/drracket/drracket/private/module-language-tools.rkt index 7e22a53bf..c7efb17f7 100644 --- a/drracket/drracket/private/module-language-tools.rkt +++ b/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) diff --git a/drracket/drracket/tool-lib.rkt b/drracket/drracket/tool-lib.rkt index a5d88ca4e..c7be0a1aa 100644 --- a/drracket/drracket/tool-lib.rkt +++ b/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. diff --git a/drracket/scribblings/tools/lang-tools.scrbl b/drracket/scribblings/tools/lang-tools.scrbl index ae6fca073..28ba19cd5 100644 --- a/drracket/scribblings/tools/lang-tools.scrbl +++ b/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