fixed bug in repl with continuations crossing between the defs and ints
svn: r1132
This commit is contained in:
Robby Findler
parent
c3c9dd7a02
commit
f9fb34a0d8
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
BIN
collects/icons/PLT-206-small.png
Normal file
BIN
collects/icons/PLT-206-small.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.4 KiB |
|
|
@ -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")
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user