From 7a1538764e01f15a5baadce1254b463685175829 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 19 Jun 2010 12:25:07 -0500 Subject: [PATCH] Added the ability for #lang-based languages to specify when an expression should be submitted at the prompt --- collects/drracket/private/drsig.rkt | 1 + collects/drracket/private/init.rkt | 2 ++ collects/drracket/private/module-language.rkt | 33 ++++++++++++++++++- collects/drracket/private/rep.rkt | 18 ++++++++-- collects/scribblings/tools/tools.scrbl | 19 +++++++++++ 5 files changed, 70 insertions(+), 3 deletions(-) diff --git a/collects/drracket/private/drsig.rkt b/collects/drracket/private/drsig.rkt index 8d055756a4..34ec9c70f4 100644 --- a/collects/drracket/private/drsig.rkt +++ b/collects/drracket/private/drsig.rkt @@ -119,6 +119,7 @@ system-custodian system-eventspace system-namespace + system-security-guard first-dir)) (define-signature drracket:language-configuration-cm^ diff --git a/collects/drracket/private/init.rkt b/collects/drracket/private/init.rkt index bf7d7f5772..eb331b133f 100644 --- a/collects/drracket/private/init.rkt +++ b/collects/drracket/private/init.rkt @@ -28,6 +28,8 @@ (define error-display-handler-message-box-title (make-parameter (string-constant drscheme-internal-error))) + (define system-security-guard (current-security-guard)) + ;; override error-display-handler to duplicate the error ;; message in both the standard place (as defined by the ;; current error-display-handler) and in a message box diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index 756e6ddf69..f6d9e6f176 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -6,6 +6,7 @@ racket/list racket/path racket/contract + racket/sandbox mred compiler/embed compiler/cm @@ -29,7 +30,8 @@ (define module-language<%> (interface () - get-users-language-name)) + get-users-language-name + get-language-info)) ;; add-module-language : -> void ;; adds the special module-only language to drscheme @@ -58,6 +60,26 @@ (define (module-mixin %) (class* % (drracket:language:language<%> module-language<%>) + (define language-info #f) ;; a result from module-compiled-language-info + (define sandbox #f) ;; a sandbox for querying the language-info + (define/public (get-language-info key default) + (init-sandbox) + (cond + [(and language-info sandbox) + (let ([mp (vector-ref language-info 0)] + [name (vector-ref language-info 1)] + [val (vector-ref language-info 2)]) + (call-in-sandbox-context + sandbox + (λ () + (parameterize ([current-security-guard drracket:init:system-security-guard]) + (((dynamic-require mp name) val) key default)))))] + [else default])) + (define (init-sandbox) + (unless sandbox + (when language-info + (set! sandbox (make-evaluator 'racket/base))))) + (inherit get-language-name) (define/public (get-users-language-name defs-text) (let* ([defs-port (open-input-text-editor defs-text)] @@ -191,6 +213,12 @@ (define/override (on-execute settings run-in-user-thread) (super on-execute settings run-in-user-thread) + + ;; reset the language info so that if the module is illformed, + ;; we don't save the language info from the last run + (set! language-info #f) + (set! sandbox #f) + (run-in-user-thread (λ () (current-command-line-arguments @@ -323,6 +351,9 @@ (check-interactive-language)) (define (*do-module-specified-configuration) (let ([info (module->language-info modspec #t)]) + (parameterize ([current-eventspace drracket:init:system-eventspace]) + (queue-callback + (λ () (set! language-info info)))) (when info (let ([get-info ((dynamic-require (vector-ref info 0) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 15b07cada2..fc50383841 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -993,8 +993,22 @@ TODO (send key get-control-down) (send key get-alt-down) (and prompt-position - (only-whitespace-after-insertion-point) - (submit-predicate this prompt-position)))) + (let ([lang (drracket:language-configuration:language-settings-language user-language-settings)]) + (cond + [(is-a? lang drracket:module-language:module-language<%>) + (let ([pred + (send lang get-language-info + 'drracket:submit-predicate + (λ (editor prompt-position) + (and (only-whitespace-after-insertion-point) + (submit-predicate this prompt-position))))]) + (pred + ;; no good! giving away the farm here. need to hand over a proxy that is limited to just read access + this + prompt-position))] + [else + (and (only-whitespace-after-insertion-point) + (submit-predicate this prompt-position))]))))) (define/private (only-whitespace-after-insertion-point) (let ([start (get-start-position)] diff --git a/collects/scribblings/tools/tools.scrbl b/collects/scribblings/tools/tools.scrbl index e9438796c8..a96b45fd75 100644 --- a/collects/scribblings/tools/tools.scrbl +++ b/collects/scribblings/tools/tools.scrbl @@ -465,6 +465,25 @@ uses Racket mode. @section{Language-specific capabilities} +@subsection{Customizing DrRacket's behavior} + +When using the language declared in the source, DrRacket queries that +language via @racket[module-compiled-language-info] to determine +if an expression in the interactions window is ready to be submitted +to the evaluator (when the user types return). +The info procedure is passed @racket['drracket:submit-predicate] +and should return a function with this contract: +@racketblock[(-> (is-a?/c text%) + number? + boolean?)] +This function is called with the interactions window's editor object +the first position in the editor after the prompt and should return +a boolean indicating if the expression should be evaluated. +This function is called in sandbox, but with no filesystem or networking +limits. + +@subsection{Customizing DrRacket's GUI} + DrRacket's capability interface provides a mechanism for tools to allow languages to hide their GUI interface, if the tool does not apply to the language. Tools register