diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index ab5d438b41..8ea7634de8 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -46,7 +46,11 @@ ;; if a language is registered with this position, it is ;; considered the default language (define default-language-position - (list (string-constant not-really-languages) + (list (string-constant teaching-languages) + (string-constant how-to-design-programs) + (string-constant beginning-student)) + #; + (list (string-constant initial-language-category) (string-constant choose-a-language-language))) ;; languages : (listof (instanceof language<%>)) @@ -1329,14 +1333,15 @@ (string-constant r5rs-one-line-summary) r5rs-mixin)) - (add-language - (make-simple 'mzscheme - (list (string-constant not-really-languages) - (string-constant choose-a-language-language)) - (list 10000 1000) - #f - "Helps the user choose an initial language" - not-a-language-extra-mixin)))) + #; + (add-language + (make-simple 'mzscheme + (list (string-constant initial-language-category) + (string-constant choose-a-language-language)) + (list 10000 1000) + #f + "Helps the user choose an initial language" + not-a-language-extra-mixin)))) (define (not-a-language-extra-mixin %) (class % @@ -1471,6 +1476,24 @@ (send link-sd set-delta-foreground "blue")) (define (display-text-pl lst) + (let ([icon-lst (car lst)] + [text-name (cadr lst)] + [lang (cddr lst)]) + (display-two-line-choice + icon-lst + lang + (λ (inner-txt) + (send inner-txt insert (format "~a\n~a" text-name (string-constant start-with-before))) + (send inner-txt change-style err-style-delta 0 (send inner-txt last-position)) + (send inner-txt insert (lang-link-snip lang)) + (let ([before-pos (send inner-txt last-position)]) + (send inner-txt insert (string-constant start-with-after)) + (send inner-txt change-style + err-style-delta + before-pos + (send inner-txt last-position))))))) + + (define (display-two-line-choice icon-lst lang proc) (let* ([outer-txt (new text:standard-style-list%)] [outer-es (new editor-snip% (editor outer-txt) (with-border? #f) [left-margin 0] @@ -1480,22 +1503,11 @@ [inner-txt (new text:standard-style-list%)] [inner-es (new editor-snip% (editor inner-txt) (with-border? #f) [top-margin 0] [bottom-margin 0])] - [icon-lst (car lst)] [icon-path - (build-path (apply collection-path (cdr icon-lst)) (car icon-lst))] - [name (cadr lst)] - [lang (cddr lst)])style-delta% + (build-path (apply collection-path (cdr icon-lst)) (car icon-lst))]) (send outer-txt insert (make-object image-snip% icon-path)) (send outer-txt insert inner-es) - (send inner-txt insert (format "~a\n~a" name (string-constant start-with-before))) - (send inner-txt change-style err-style-delta 0 (send inner-txt last-position)) - (send inner-txt insert (lang-link-snip lang)) - (let ([before-pos (send inner-txt last-position)]) - (send inner-txt insert (string-constant start-with-after)) - (send inner-txt change-style - err-style-delta - before-pos - (send inner-txt last-position))) + (proc inner-txt) (send outer-txt change-style (make-object style-delta% 'change-alignment 'top) 0 diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index ae3feccdcc..7e6e3716a7 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -879,17 +879,16 @@ TODO (set! already-warned? #t) (insert-warning))) - ;; put two eofs in the port; one to terminate a potentially incomplete sexp - ;; (or a non-self-terminating one, like a number) and the other to ensure that - ;; an eof really does come thru the calls to `read'. - ;; the cleanup thunk clears out the extra eof, if one is still there after evaluation - (send-eof-to-in-port) + ;; lets us know we are done with this one interaction + ;; (since there may be multiple expressions at the prompt) (send-eof-to-in-port) + (set! prompt-position #f) (evaluate-from-port (get-in-port) #f (λ () + ;; clear out the eof object if it wasn't consumed (clear-input-port)))) ;; prompt-position : (union #f integer) @@ -924,6 +923,10 @@ TODO (define/public (set-submit-predicate p) (set! submit-predicate p)) + ;; record this on an ivar in the class so that + ;; continuation jumps into old calls to evaluate-from-port + ;; continue to evaluate from the correct port. + (define get-sexp/syntax/eof #f) (define/public (evaluate-from-port port complete-program? cleanup) ; =Kernel=, =Handler= (send context disable-evaluation) (send context reset-offer-kill) @@ -940,11 +943,11 @@ TODO (λ () ; =User=, =Handler=, =No-Breaks= (let* ([settings (current-language-settings)] [lang (drscheme:language-configuration:language-settings-language settings)] - [settings (drscheme:language-configuration:language-settings-settings settings)] - [get-sexp/syntax/eof + [settings (drscheme:language-configuration:language-settings-settings settings)]) + (set! get-sexp/syntax/eof (if complete-program? (send lang front-end/complete-program port settings user-teachpack-cache) - (send lang front-end/interaction port settings user-teachpack-cache))]) + (send lang front-end/interaction port settings user-teachpack-cache))) ; Evaluate the user's expression. We're careful to turn on ; breaks as we go in and turn them off as we go out. diff --git a/collects/icons/PLT-206-small.png b/collects/icons/PLT-206-small.png new file mode 100644 index 0000000000..b959a1f356 Binary files /dev/null and b/collects/icons/PLT-206-small.png differ diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index bf4263cc42..3da101327a 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -981,8 +981,8 @@ please adhere to these guidelines: (professional-languages "Professional Languages") (teaching-languages "Teaching Languages") (experimental-languages "Experimental Languages") - (not-really-languages "Not really languages") - (choose-a-language-language "Choose a language language") + (initial-language-category "Initial language") + (choose-a-language-language "Choose-a-language language") (module-language-one-line-summary "Run creates a REPL in the context of the module, including the module's declared language") diff --git a/collects/tests/drscheme/repl-test.ss b/collects/tests/drscheme/repl-test.ss index 5325bd42cc..0effc9f6d3 100644 --- a/collects/tests/drscheme/repl-test.ss +++ b/collects/tests/drscheme/repl-test.ss @@ -622,8 +622,8 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!) void) (make-test "(write-special 1)" - "1" - "1" + "1#t" + "1#t" #f 'interactions #f @@ -708,7 +708,7 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!) #f void void) - + ;; graphical lambda tests (make-test (list "((" '("Special" "Insert λ") "(x) x) 1)") "1" @@ -1047,7 +1047,13 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!) (when (send (send drscheme-frame get-interactions-text) local-edit-sequence?) (error 'kill-test3 "in edit-sequence"))) - + (define (callcc-test) + (error 'callcc-test) + "(define kont #f) (let/cc empty (set! kont empty))" ;; in defs + "(kont)" ;; in repl 1 + "x" ;; in repl2 + ;; make sure error message comes out + ) ;; run the tests (when (file-exists? tmp-load-filename) @@ -1058,4 +1064,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!) (run-test-in-language-level #f) (run-test-in-language-level #t) + (kill-tests) + (callcc-test) ))