diff --git a/collects/framework/private/finder.ss b/collects/framework/private/finder.ss index e8f00882..c4f348bf 100644 --- a/collects/framework/private/finder.ss +++ b/collects/framework/private/finder.ss @@ -1,3 +1,4 @@ + (module finder mzscheme (require (lib "unitsig.ss") "sig.ss" diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 4df28835..b18815ac 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -153,7 +153,7 @@ (accept-drop-files #t) - (make-object menu% "&Windows" (make-object (get-menu-bar%) this)) + (make-object menu% "&Window" (make-object (get-menu-bar%) this)) (reorder-menus this) (send (group:get-the-frame-group) insert-frame this)) (private-field diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index a9de27b7..fdfcaac4 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -61,6 +61,7 @@ (hash-table-put! hash-table (add-#% x) 'lambda) (hash-table-put! hash-table x 'lambda)) '( + instantiate lambda let let* letrec recur with-syntax module diff --git a/collects/framework/private/standard-menus-items.ss b/collects/framework/private/standard-menus-items.ss index ef62470d..3d5e694a 100644 --- a/collects/framework/private/standard-menus-items.ss +++ b/collects/framework/private/standard-menus-items.ss @@ -312,7 +312,7 @@ (make-between 'edit-menu 'find 'preferences 'separator) (make-an-item 'edit-menu 'preferences "Configure the preferences" '(lambda (item control) (preferences:show-dialog) #t) - #f "Preferences..." "" + #\; "Preferences..." "" on-demand-do-nothing) (make-after 'edit-menu 'preferences 'nothing) diff --git a/collects/framework/splash.ss b/collects/framework/splash.ss index ca08af40..3c8c927b 100644 --- a/collects/framework/splash.ss +++ b/collects/framework/splash.ss @@ -116,7 +116,8 @@ (when quit-on-close? (exit)))]) (sequence (super-init title)))] - [(frame) (parameterize ([current-eventspace (make-eventspace)]) + [(splash-eventspace) (make-eventspace)] + [(frame) (parameterize ([current-eventspace splash-eventspace]) (make-object splash-frame% title))] [(_0) (send frame accept-drop-files #t)] [(bitmap-flag) @@ -189,6 +190,9 @@ (set! quit-on-close? #f) (send frame show #f))]) (values + bitmap + logo-canvas + splash-eventspace get-dropped-files shutdown-splash close-splash))))) diff --git a/collects/tests/utils/gui.ss b/collects/tests/utils/gui.ss index d5b89c91..a2101ff2 100644 --- a/collects/tests/utils/gui.ss +++ b/collects/tests/utils/gui.ss @@ -1,16 +1,15 @@ (module gui mzscheme - (require (lib "mred.ss" "mred")) + (require (lib "mred.ss" "mred") + (lib "class.ss") + (lib "etc.ss")) (provide find-labelled-window) - + ;;; find-labelled-window : (union ((union #f string) -> window<%>) ;;; ((union #f string) (union #f class) -> window<%>) - ;;; ((union #f string) (union class #f) area-container<%> -> area-container<%>)) + ;;; ((union #f string) (union class #f) area-container<%> -> window<%>)) ;;;; may call error, if no control with the label is found (define find-labelled-window - (case-lambda - [(label) (find-labelled-window label #f)] - [(label class) (find-labelled-window label class (get-top-level-focus-window))] - [(label class window) + (opt-lambda (label [class #f] [window (get-top-level-focus-window)]) (unless (or (not label) (string? label)) (error 'find-labelled-window "first argument must be a string or #f, got ~e; other args: ~e ~e" @@ -39,4 +38,4 @@ window (if class (format " matching class ~e" class) - ""))))])))) \ No newline at end of file + ""))))))) \ No newline at end of file