From f9fb34a0d866b296ac0a2f57c8180b2378fe14d3 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 23 Oct 2005 03:18:58 +0000 Subject: [PATCH] fixed bug in repl with continuations crossing between the defs and ints svn: r1132 --- .../private/language-configuration.ss | 56 +++++++++++------- collects/drscheme/private/rep.ss | 19 +++--- collects/icons/PLT-206-small.png | Bin 0 -> 2421 bytes .../english-string-constants.ss | 4 +- collects/tests/drscheme/repl-test.ss | 16 +++-- 5 files changed, 59 insertions(+), 36 deletions(-) create mode 100644 collects/icons/PLT-206-small.png 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 0000000000000000000000000000000000000000..b959a1f3563b2afdb60ebcb0fdfbcc527de019eb GIT binary patch literal 2421 zcmV-*35xcKP)R0{lyZz4j?z!ij zcUvda4-N4VRv$TL=D`RnlzUHmekl98XAvMT7307-AgHtR5#74gMOUwOh-=p#h`PES z(bZ-AAA!##KpXH7A9aFEc)qi-k?&l*#1+L?`D)1xK7PD}H*PGZv18AXlhf}sefoLc zu%V1ko^0Uu_CCw=(zoQ#>_1h27#N_g!a_2vUr%@5dygAmeU)3LP2=X`i+sn>z?GFZ z$<3{dbh;vt$2#3He*XDP{`AvRoRU(*Jv~Otw*21$jIFJFZ^sV0_sT2OtJ9H5r(;qP z&d&U(vy<<)wbGRakq^P z2{?y!f>pLKY81mW_aj1W5V3i44Sw=(Oq~a(Kn_R)2WiTbbh>=`?z0Q%Z))O}dGq*@ z*_q;83>F{>2$0L7fq_0MC}^Tlqi*8%Wl*3-;V4MKcCFEWpM_D2{Dy&B*!BJ|ofFE6jFGqQ3qh6BPp`o>GZ(pM3!7*74Fp&siKqSU~ymDm{cXV_}?~jwv)Zb5aix+eEphUBT zTndnmHRmHnFz4qpm6j5hlqf6e>gwdu(prA^-BSFd5FD44U?pH5#sNHb>~1b7DCYkD zKC=M1f?mCz{xg0&_gM>ovnK>-5s-7Af6iQA&opBO@ywYr3+Vy+LS0=gx}g>UO+W(p zRgFLpBILoIp8L76(ZDitih%p*b``^ivvIHhx!>yEvz?t;fTJUGYAW;L!z>&eh=&a$ zQ(_{uJ$S%1HC3FReuYPm&R2UuDjdfvrHD#U1n6`>^1OK-TwGkleSLjq0fyvcx(-AiDvyv}fEaor2JdNAg;1J1Xq|@yOzhE4w2$(Wu zJ@g;qHbhS5fY9&TCrV++s{R$n!q!%)0816T{4!Bq9#MWi(TEXBpOEyt^pd!JwbqEW~zZXCJ3eK9LoWp!5LjKM2FvA8dz!RkUZ1 z58b$N!z`daHC5yx%(XDuuSP*>M4AA((sAR6Dk_L-Yl)qllzF_ML?^fn%EynVqO2@B zg$U*3WRZu*A#!v)h)1L3>OnA^?*Z;Kd9n+6d3j2~Ldk)q3m51lN~;8WjMcDda37F4 z;OlE{;K9K%HC_IFY!a0o|&V#RnfK$=U%LFn1F`IGx2f_oI*a zC@LfwO)V}i79|;l_AK{4gk%%K{-bDC@%;HN?BlbW%gf8n0*q)xh0B-o5g0iKV3hBI zHW==*v!mX?KL4Z4t8MBOCTwD>zV6Me>DgtCntvqss6H((is)%w>1;e){O(H!yp1!7r>%RDc zt8pKWxeOFzz7YHdGBG|3;ukF7=$IIejEv;)@G#_S5IH#b%It@LHT>a+OL^V8e{cds z-oyLH@-FCTY2l1nvp7Mn1msHx_V!fbgR@o|92(IM#^ zL_0ZgWMClg4G)*Aq+PrG>CHF2AYdbp9J!R2ELp)jc5G)<3qO4L(A)>)@y~>dGSqU^ z$dLp?lnzczoG9|LvqeE+p(t3mkRXaqgIv`yRxQ#%GKj-C8bqQq?p?c4B04Tk#QpGtNJKeer3#5at~eHs z4}g6j9OF0~1Hs^*82f^sz)pL6-Z+0gJEJ=; zTC@l&Ux9<`CQeLDz{ES zPH8vrmX5(@um&u_>;0Pr3&?fVD%yeLeJc8cbS@XDxl>-pLmkVtNZh@9mrmeK={t8W zxsM*r?x_9kFz%rOhqMjADXqhJ75EOX^~Gpv&M3zX_(Kzj9&+Z)85wrV%K!3zfhIyZ zYW4I`MP(&rpbY(7U3t^gsrCkjH;`vwS;^2KPJ{cP>yUSlN7>rI0aoOD&mZ^G>$@@2l@Jv|L)!NGrmJZLpdfk zmNT=m_|m0IO1OI