From bf53fd5c38e34f92bf55fb2b7ca871dfe2e2c3d3 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 19 Dec 2010 06:27:30 -0600 Subject: [PATCH] adjust the auto-text behavior of DrRacket so that it doesn't require the queue-callback / execute callback dance; also, change the behavior a little bit so that it works a little bit more like the rest of the DrRacket languages; in particular, the initialization of the REPL now only happens when a window is first opened or a new tab is first created, but not at other times (ie not when the language changes; when the language changes, we just keep the REPL state the same and show a warning like before) This change also required a change to the way the repl is initialized and a slight change to the behavior of the first-opened method. Specifically, it is now called in a slightly better context so that errors that happen look like errors in the user's program. The only other use of the first-opened method in the tree was to initialize the teachpacks in the teaching languages and this new behavior is also an improvement there. --- collects/drracket/private/module-language.rkt | 30 ++++++++++-- collects/drracket/private/rep.rkt | 49 +++++++++---------- collects/drracket/private/unit.rkt | 35 +++++++------ collects/lang/htdp-langs.rkt | 3 +- collects/scribblings/tools/language.scrbl | 26 +++++----- collects/scribblings/tools/rep.scrbl | 17 +++++-- 6 files changed, 94 insertions(+), 66 deletions(-) diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index 402e7811c0..69ad796ad4 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -81,6 +81,24 @@ (when language-info (set! sandbox (make-evaluator 'racket/base))))) + (define/override (first-opened settings) + (define ns (get-ns (get-auto-text settings))) + (when ns (current-namespace ns))) + + (define/private (get-ns str) + (define ev (make-evaluator 'racket/base)) + (ev `(parameterize ([read-accept-reader #t]) + (define stx (read-syntax "here" (open-input-string ,str))) + (define modname + (syntax-case stx () + [(module name . stuff) + `',(syntax->datum #'name)] + [_ #f])) + (and modname + (eval stx) + (namespace-require modname) + (module->namespace modname))))) + (inherit get-language-name) (define/public (get-users-language-name defs-text) (let* ([defs-port (open-input-text-editor defs-text)] @@ -278,7 +296,9 @@ (define repl-init-thunk (make-thread-cell #f)) (define/override (front-end/complete-program port settings) - (define (super-thunk) ((get-reader) (object-name port) port)) + (define (super-thunk) + (define reader (get-reader)) + (reader (object-name port) port)) (define path (cond [(get-filename port) => (compose simplify-path cleanse-path)] [else #f])) @@ -290,7 +310,7 @@ (let ([expr ;; just reading the definitions might be a syntax error, ;; possibly due to bad language (eg, no foo/lang/reader) - (with-handlers ([exn? (λ (e) + (with-handlers ([exn:fail? (λ (e) ;; [Eli] FIXME: use `read-language' on `port' after calling ;; `file-position' to reset it to the beginning (need to ;; make sure that it's always a seekable port), then see @@ -298,8 +318,8 @@ ;; the port (a second reset), construct a string holding ;; the #lang, and read from it an empty module, and extract ;; the base module from it (ask Matthew about this). - (raise-hopeless-exception - e "invalid module text"))]) + (raise-hopeless-exception + e "invalid module text"))]) (super-thunk))]) (when (eof-object? expr) (raise-hopeless-syntax-error)) (let ([more (super-thunk)]) @@ -471,7 +491,7 @@ (custodian-shutdown-all (send rep get-user-custodian))) (define (raise-hopeless-syntax-error . error-args) - (with-handlers ([exn? raise-hopeless-exception]) + (with-handlers ([exn:fail? raise-hopeless-exception]) (apply raise-syntax-error '|Module Language| (if (null? error-args) (list (string-append diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index a71ee27ba5..ed829b91b0 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -1674,34 +1674,29 @@ TODO (thaw-colorer) (send context disable-evaluation) (reset-console) - - (let ([exn-raised #f] - [lang (drracket:language-configuration:language-settings-language user-language-settings)]) - (queue-user/wait - (λ () ; =User=, =No-Breaks= - (with-handlers ((exn:fail? (λ (x) (set! exn-raised x)))) - (cond - ;; this is for backwards compatibility; drracket used to - ;; expect this method to be a thunk (but that was a bad decision) - [(object-method-arity-includes? lang 'first-opened 1) - (send lang first-opened - (drracket:language-configuration:language-settings-settings user-language-settings))] - [else - ;; this is the backwards compatible case. - (send lang first-opened)])))) - (when exn-raised - (let ([sp (open-output-string)]) - (parameterize ([current-error-port sp]) - (drracket:init:original-error-display-handler (exn-message exn-raised) exn-raised)) - (message-box (string-constant drscheme) - (format "Exception raised while running the first-opened method of the language ~s:\n~a" - (send lang get-language-position) - (get-output-string sp)))))) - (insert-prompt) - (send context enable-evaluation) - (end-edit-sequence) - (clear-undos)) + + (let ([lang (drracket:language-configuration:language-settings-language user-language-settings)] + [drr-evtspace (current-eventspace)]) + (run-in-evaluation-thread + (λ () + (let/ec k + (parameterize ([error-escape-handler (λ () (k (void)))]) + (cond + ;; this is for backwards compatibility; drracket used to + ;; expect this method to be a thunk (but that was a bad decision) + [(object-method-arity-includes? lang 'first-opened 1) + (send lang first-opened + (drracket:language-configuration:language-settings-settings user-language-settings))] + [else + ;; this is the backwards compatible case. + (send lang first-opened)]))) + (parameterize ([current-eventspace drr-evtspace]) + (queue-callback + (λ () + (send context enable-evaluation) + (end-edit-sequence) + (clear-undos)))))))) (define indenting-limit 0) (define/override (get-limit n) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 80a4c50233..c6461bf677 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -51,6 +51,11 @@ module browser threading seems wrong. (define define-button-long-label "(define ...)") + (define oprintf + (let ([op (current-output-port)]) + (λ args + (apply fprintf op args)))) + (define-unit unit@ (import [prefix help-desk: drracket:help-desk^] [prefix drracket:app: drracket:app^] @@ -76,7 +81,8 @@ module browser threading seems wrong. set-visible-defs set-focus-d/i get-i - set-i) + set-i + insert-auto-text) (define tab<%> (interface (drracket:rep:context<%>) get-frame @@ -693,7 +699,12 @@ module browser threading seems wrong. (define/pubment (already-warned) (set! already-warned-state #t)) + ;; the really-modified? flag determines if there + ;; is a modification that is not the insertion of the auto-text (define really-modified? #f) + + ;; when this flag is #t, edits to the buffer do not count as + ;; user's edits and so the yellow warning does not appear (define ignore-edits? #f) (define/augment (after-insert x y) @@ -776,7 +787,7 @@ module browser threading seems wrong. (not (is-modified?)) (not (get-filename)))) ;; inserts the auto-text if any, and executes the text if so - (define/private (insert-auto-text) + (define/public (insert-auto-text) (define lang (drracket:language-configuration:language-settings-language next-settings)) @@ -788,20 +799,13 @@ module browser threading seems wrong. (drracket:language-configuration:language-settings-settings next-settings)))) (when auto-text + (set! ignore-edits? #t) (begin-edit-sequence #f) (insert auto-text) (set-modified #f) + (set! ignore-edits? #f) (end-edit-sequence) - (set! really-modified? #f) - ;; HACK: click run; would be better to override on-execute and - ;; make it initialize a working repl, but the problem is that - ;; doing that in module-language.rkt means that it'll either need - ;; to find if the current text is the auto-text and analyze it to - ;; get this initialization, or it will need to do that for all - ;; possible contents, which means that it'll work when opening - ;; exiting files too (it might be feasible once we have a #lang - ;; parser). - (send (get-top-level-window) execute-callback))) + (set! really-modified? #f))) (define/private (remove-auto-text) (when (and (not really-modified?) (not (get-filename)) @@ -821,8 +825,6 @@ module browser threading seems wrong. (super-new [show-line-numbers? (show-line-numbers?)]) - ;; insert the default-text - (queue-callback (lambda () (insert-auto-text))) (highlight-first-line (is-a? (drracket:language-configuration:language-settings-language next-settings) drracket:module-language:module-language<%>)) @@ -2708,7 +2710,8 @@ module browser threading seems wrong. (send defs set-interactions-text ints) (send defs set-tab tab) (send ints set-definitions-text defs) - (send defs change-mode-to-match))) + (send defs change-mode-to-match) + (send defs insert-auto-text))) ; @@ -4647,12 +4650,12 @@ module browser threading seems wrong. (define (create-new-drscheme-frame filename) (let* ([drs-frame% (drracket:get/extend:get-unit-frame)] [frame (new drs-frame% (filename filename))]) - (send (send frame get-interactions-text) initialize-console) (when first-frame? (let ([pos (preferences:get 'drracket:frame:initial-position)]) (when pos (send frame move (car pos) (cdr pos))))) (send frame update-toolbar-visibility) (send frame show #t) + (send (send frame get-interactions-text) initialize-console) (set! first-frame? #f) frame))) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index 0ac6818765..82c940744d 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -432,8 +432,7 @@ (define/override (first-opened settings) (for ([tp (in-list (htdp-lang-settings-teachpacks settings))]) - (with-handlers ((exn:fail? void)) ;; swallow errors here; drracket is not ready to display errors at this point - (for-each namespace-require/constant tp)))) + (for-each namespace-require/constant tp))) (inherit get-module get-transformer-module get-init-code use-namespace-require/copy?) diff --git a/collects/scribblings/tools/language.scrbl b/collects/scribblings/tools/language.scrbl index 6c0024f7bc..281cd08093 100644 --- a/collects/scribblings/tools/language.scrbl +++ b/collects/scribblings/tools/language.scrbl @@ -628,25 +628,27 @@ default settings obtained via } -@defmethod*[([(first-opened [settings settings]) void?] - [(first-opened) void?])]{ +@defmethod*[([(first-opened [settings settings]) void?])]{ -This method is called when the language is initialized, but -no program is run. It is called from the user's eventspace's -main thread. +This method is called after the language is initialized, but +no program has yet been run. It is called from the user's +eventspace's main thread. See also @method[drracket:rep:text% initialize-console]. Calling this method should not raise an exception (or otherwise -try to escape). DrRacket is not in a position to signal the errors -as user errors when this is called. An error will cause DrRacket -to hang. +try to escape). DrRacket calls this method in a @racket[parameterize] +where the @racket[error-escape-handler] is set to an escaping +continuation that continues initializing the interactions window. +Thus, raising an exception will report the error in the user's +interactions window as if this were a bug in the user's program. +Escaping in any other way, however, can cause DrRacket to fail +to start up. -Contrary to the method contract space, this method -does not have to accept both zero and one arguments; the zero argument -version is for backwards compatibility and drracket tests the arity of the -method before invoking it. +Contrary to the method contract space, DrRacket will also invoke this +method if it has zero arguments, passing nothing; the zero argument +version is for backwards compatibility and is not recommended. } diff --git a/collects/scribblings/tools/rep.scrbl b/collects/scribblings/tools/rep.scrbl index 7675443f96..86f8dcaae9 100644 --- a/collects/scribblings/tools/rep.scrbl +++ b/collects/scribblings/tools/rep.scrbl @@ -217,8 +217,7 @@ See also } -@defmethod[(initialize-console) - void?]{ +@defmethod[(initialize-console) void?]{ This inserts the ``Welcome to DrRacket'' message into the interactions buffer, calls @@ -227,12 +226,22 @@ buffer, calls @method[editor<%> clear-undos]. Once the console is initialized, this method calls -@method[drracket:language:language<%> first-opened]. Accordingly, this method should not be called to initialize +@method[drracket:language:language<%> first-opened]. +Accordingly, this method should not be called to initialize a REPL when the user's evaluation is imminent. That is, this method should be called when new tabs or new windows are created, but not when the Run button is clicked. - +This method calls the +@method[drracket:language:language<%> first-opened] +from the user's eventspace's main thread and, when +@method[drracket:language:language<%> first-opened] +returns, it enqueue's a callback that ends +an edit sequence on the REPL and calls +@method[editor<%> clear-undos]. Accordingly, if the +@method[drracket:language:language<%> first-opened] +method does not return, the interactions text will +be in an unclosed edit sequence. } @defmethod[(insert-prompt)