From c8e89dfd65641166976d74e5775546803079ee51 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 9 Apr 2001 01:06:43 +0000 Subject: [PATCH] no message original commit: 2711ca7727891e9e99871a9fe0267ab1e8138d6b --- .../framework/private/gen-standard-menus.ss | 19 +++---- collects/framework/private/menu.ss | 56 +++++++++---------- collects/framework/private/text.ss | 2 +- collects/tests/framework/frame.ss | 4 -- collects/tests/framework/load.ss | 6 +- collects/tests/framework/test-suite-utils.ss | 1 + 6 files changed, 42 insertions(+), 46 deletions(-) diff --git a/collects/framework/private/gen-standard-menus.ss b/collects/framework/private/gen-standard-menus.ss index b5487286..45158870 100644 --- a/collects/framework/private/gen-standard-menus.ss +++ b/collects/framework/private/gen-standard-menus.ss @@ -1,7 +1,3 @@ -#!/bin/sh - -string=? ; exec mred -qr $0 - (module gen-standard-menus mzscheme (require (lib "pretty.ss")) (require (lib "list.ss")) @@ -60,14 +56,15 @@ string=? ; exec mred -qr $0 `(private-field [,(an-item->item-name item) (and (,create-menu-item-name) - (make-object (class (get-menu-item%) args + (make-object (class100 (get-menu-item%) args (rename [super-on-demand on-demand]) - (override on-demand) - (define (on-demand) - (lambda () - (,(an-item->on-demand-name item) this) - (super-on-demand))) - (apply super-init args)) + (override + [on-demand + (lambda () + (,(an-item->on-demand-name item) this) + (super-on-demand))]) + (sequence + (apply super-init args))) ,(join menu-before-string menu-after-string `(,(an-item->string-name item))) ,(menu-item-menu-name item) diff --git a/collects/framework/private/menu.ss b/collects/framework/private/menu.ss index 0b68a5a0..45b000ac 100644 --- a/collects/framework/private/menu.ss +++ b/collects/framework/private/menu.ss @@ -5,33 +5,33 @@ "sig" "../macro.ss" (lib "mred-sig.ss" "mred")) - + (provide menu@) - + (define menu@ -(unit/sig framework:menu^ - (import mred^ - [preferences : framework:preferences^]) - - (define can-restore<%> - (interface (selectable-menu-item<%>) - restore-keybinding)) - - (define can-restore-mixin - (mixin (selectable-menu-item<%>) (can-restore<%>) args - (inherit set-shortcut get-shortcut) - (private-field - [saved-shortcut 'not-yet]) - (public - [restore-keybinding - (lambda () - (unless (eq? saved-shortcut 'not-yet) - (set-shortcut saved-shortcut)))]) - (sequence - (apply super-init args) - (set! saved-shortcut (get-shortcut)) - (unless (preferences:get 'framework:menu-bindings) - (set-shortcut #f))))) - - (define can-restore-menu-item% (can-restore-mixin menu-item%)) - (define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%))))) \ No newline at end of file + (unit/sig framework:menu^ + (import mred^ + [preferences : framework:preferences^]) + + (define can-restore<%> + (interface (selectable-menu-item<%>) + restore-keybinding)) + + (define can-restore-mixin + (mixin (selectable-menu-item<%>) (can-restore<%>) args + (inherit set-shortcut get-shortcut) + (private-field + [saved-shortcut 'not-yet]) + (public + [restore-keybinding + (lambda () + (unless (eq? saved-shortcut 'not-yet) + (set-shortcut saved-shortcut)))]) + (sequence + (apply super-init args) + (set! saved-shortcut (get-shortcut)) + (unless (preferences:get 'framework:menu-bindings) + (set-shortcut #f))))) + + (define can-restore-menu-item% (can-restore-mixin menu-item%)) + (define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%))))) \ No newline at end of file diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index aeb91b52..b5d8e9c5 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -2,7 +2,7 @@ (require (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") - "sig" + "sig.ss" "../macro.ss" "../gui-utils-sig.ss" (lib "mred-sig.ss" "mred") diff --git a/collects/tests/framework/frame.ss b/collects/tests/framework/frame.ss index b3fb4178..5b0013e5 100644 --- a/collects/tests/framework/frame.ss +++ b/collects/tests/framework/frame.ss @@ -1,5 +1,3 @@ -#| - (define (test-creation name class-expression) (test name @@ -138,8 +136,6 @@ (test-open "frame:searchable open" 'frame:searchable%) (test-open "frame:text-info open" 'frame:text-info-file%) -|# - (test "set!-ing menu callback in standard-menus-frame" (lambda (x) (eq? x 'passed)) diff --git a/collects/tests/framework/load.ss b/collects/tests/framework/load.ss index 46229b87..a83600d6 100644 --- a/collects/tests/framework/load.ss +++ b/collects/tests/framework/load.ss @@ -7,11 +7,13 @@ (test (string->symbol file) void? - `(let ([orig-namespace (current-namespace)]) + `(let ([mred-name + ((current-module-name-resolver) '(lib "mred.ss" "mred") #f #f)] + [orig-namespace (current-namespace)]) (parameterize ([current-namespace (make-namespace)]) (namespace-attach-module orig-namespace - ((current-module-name-resolver) '(lib "mred.ss" "mred"))) + mred-name) (eval '(require (lib ,file "framework"))) (with-handlers ([(lambda (x) #t) (lambda (x) diff --git a/collects/tests/framework/test-suite-utils.ss b/collects/tests/framework/test-suite-utils.ss index d814f80a..7c7e3722 100644 --- a/collects/tests/framework/test-suite-utils.ss +++ b/collects/tests/framework/test-suite-utils.ss @@ -2,6 +2,7 @@ (require (lib "launcher.ss" "launcher") (lib "pretty.ss") (lib "list.ss") + (lib "process.ss") "debug.ss") (provide