diff --git a/htdp-lib/info.rkt b/htdp-lib/info.rkt index 3850a1dbd..3f92ade6b 100644 --- a/htdp-lib/info.rkt +++ b/htdp-lib/info.rkt @@ -21,7 +21,7 @@ "slideshow-lib" "snip-lib" "srfi-lite-lib" - "string-constants-lib" + ["string-constants-lib" #:version "1.13"] "typed-racket-lib" "typed-racket-more" "web-server-lib" diff --git a/htdp-lib/lang/htdp-langs-interface.rkt b/htdp-lib/lang/htdp-langs-interface.rkt new file mode 100644 index 000000000..a93e95ad4 --- /dev/null +++ b/htdp-lib/lang/htdp-langs-interface.rkt @@ -0,0 +1,14 @@ +#lang racket/base +(require racket/class) +(provide htdp-language<%>) + +(define htdp-language<%> + (interface () + get-module + get-language-position + get-sharing-printing + get-abbreviate-cons-as-list + get-allow-sharing? + get-use-function-output-syntax? + get-accept-quasiquote? + get-read-accept-dot)) \ No newline at end of file diff --git a/htdp-lib/lang/htdp-langs.rkt b/htdp-lib/lang/htdp-langs.rkt index f2c023da8..10d583188 100644 --- a/htdp-lib/lang/htdp-langs.rkt +++ b/htdp-lib/lang/htdp-langs.rkt @@ -29,6 +29,7 @@ lang/debugger-language-interface "run-teaching-program.rkt" "htdp-langs-save-file-prefix.rkt" + "htdp-langs-interface.rkt" (only-in test-engine/scheme-gui make-formatter) (only-in test-engine/racket-tests @@ -59,17 +60,6 @@ (define image-string "") - (define htdp-language<%> - (interface () - get-module - get-language-position - get-sharing-printing - get-abbreviate-cons-as-list - get-allow-sharing? - get-use-function-output-syntax? - get-accept-quasiquote? - get-read-accept-dot)) - ;; module-based-language-extension : (implements drscheme:language:module-based-language<%>) ;; -> (implements drscheme:language:module-based-language<%>) ;; changes the default settings and sets a few more paramters during `on-execute' diff --git a/htdp-lib/test-engine/test-tool.scm b/htdp-lib/test-engine/test-tool.scm index 5967e5dfb..641804049 100644 --- a/htdp-lib/test-engine/test-tool.scm +++ b/htdp-lib/test-engine/test-tool.scm @@ -1,7 +1,7 @@ #lang scheme/base (require scheme/file scheme/class scheme/unit scheme/contract drscheme/tool framework mred - string-constants) + string-constants lang/htdp-langs-interface) (require "test-display.scm") (provide tool@) @@ -149,13 +149,24 @@ (preferences:set 'test-engine:enable? #f))) (super-instantiate ()))] [enable? (preferences:get 'test-engine:enable?)] - [enable-menu-item (make-object enable-menu-item% - (if enable? disable-label enable-label) - language-menu - (lambda (_1 _2) - (if (send _1 is-test-enabled?) - (send _1 disable-tests) - (send _1 enable-tests))) #f)]) + [enable-menu-item + (make-object enable-menu-item% + (if enable? disable-label enable-label) + language-menu + (λ (menu-item _2) + (cond + [(is-a? (drscheme:language-configuration:language-settings-language + (send (get-definitions-text) get-next-settings)) + htdp-language<%>) + (if (send menu-item is-test-enabled?) + (send menu-item disable-tests) + (send menu-item enable-tests))] + [else + (message-box + (string-constant drracket) + (string-constant + test-engine-enable-disable-tests-only-in-teaching-languages))])) + #f)]) (send enable-menu-item set-test-enabled?! enable?) (register-capability-menu-item 'tests:test-menu language-menu))))