suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust the auto-text behavior of DrRacket so that it doesn't require the

Browse Source 
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.
This commit is contained in:
Robby Findler 2010-12-19 06:27:30 -06:00
parent ba11a02c1d
commit bf53fd5c38
6 changed files with 94 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/drracket/private/module-language.rkt
View File

@ -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

49
collects/drracket/private/rep.rkt
View File

@ -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)

35
collects/drracket/private/unit.rkt
View File

@ -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)))

3
collects/lang/htdp-langs.rkt
View File

@ -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?)

26
collects/scribblings/tools/language.scrbl
View File

@ -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.
}

17
collects/scribblings/tools/rep.scrbl
View File

@ -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)