From c68eb72239dc0e81f47a9d70be55c436b6f8ee08 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 11 Sep 2000 16:01:01 +0000 Subject: [PATCH] . original commit: 5776f3f92796d8cdd88e4f0c9ba4cd45d7effffa --- collects/framework/frame.ss | 1 + collects/framework/frameworks.ss | 8 +++ collects/framework/gen-standard-menus.ss | 62 +++++++++++----------- collects/framework/standard-menus-items.ss | 10 ++-- 4 files changed, 47 insertions(+), 34 deletions(-) diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss index 96002edd..bd4cf685 100644 --- a/collects/framework/frame.ss +++ b/collects/framework/frame.ss @@ -15,6 +15,7 @@ [pasteboard : framework:pasteboard^] [editor : framework:editor^] [canvas : framework:canvas^] + [menu : framework:menu^] [mzlib:function : mzlib:function^] [mzlib:file : mzlib:file^]) diff --git a/collects/framework/frameworks.ss b/collects/framework/frameworks.ss index 1c1ec32e..3ba5365a 100644 --- a/collects/framework/frameworks.ss +++ b/collects/framework/frameworks.ss @@ -11,6 +11,12 @@ (require-relative-library "tests.ss") (require-relative-library "guiutilss.ss") +(define-signature framework:menu^ + (can-restore<%> + can-restore-mixin + can-restore-menu-item% + can-restore-checkable-menu-item%)) + (define-signature framework:prefs-file^ (get-preferences-filename)) @@ -301,6 +307,8 @@ [unit panel : framework:panel^] + [unit menu : framework:menu^] + [unit frame : framework:frame^] [unit scheme : framework:scheme^] [unit main : framework:main^])) diff --git a/collects/framework/gen-standard-menus.ss b/collects/framework/gen-standard-menus.ss index 166e00b9..4209ba93 100755 --- a/collects/framework/gen-standard-menus.ss +++ b/collects/framework/gen-standard-menus.ss @@ -99,7 +99,7 @@ string=? ; exec mred -qr $0 ,(menu-name->id name-string) (let ([,name (lambda (item evt) (,name item evt))]) ,name) - (if (preferences:get 'framework:menu-bindings) ,key #f) + ,key (,(build-id item "-help-string"))))]))) (define build-menu-clause @@ -155,36 +155,38 @@ string=? ; exec mred -qr $0 `(define standard-menus-mixin (mixin (basic<%>) (standard-menus<%>) args (inherit on-menu-char on-traverse-char) - (rename [super-on-subwindow-char on-subwindow-char]) - (override - [on-subwindow-char - (lambda (receiver event) - (if (preferences:get 'framework:menu-bindings) - (super-on-subwindow-char receiver event) - (on-traverse-char event)))]) +; (rename [super-on-subwindow-char on-subwindow-char]) +; (override +; [on-subwindow-char +; (lambda (receiver event) +; (if (preferences:get 'framework:menu-bindings) +; (super-on-subwindow-char receiver event) +; (on-traverse-char event)))]) -; need to save old keybindings... -; (rename [super-on-close on-close]) -; (private -; [remove-prefs-callback -; (preferences:add-callback -; 'framework:menu-bindings -; (lambda (p v) -; (let ([mb (get-menu-bar)]) -; (let loop ([menu (get-menu-bar)]) -; (cond -; [(is-a? menu menu-item-container<%>) -; (for-each loop (send menu get-items))] -; [(is-a? menu selectable-menu-item<%>) -; (void)])))))]) - -; (override -; [on-close -; (lambda () -; (remove-prefs-callback) -; (super-on-close))]) - - (inherit get-menu-bar can-close? on-close show get-edit-target-object) + (rename [super-on-close on-close]) + (private + [remove-prefs-callback + (preferences:add-callback + 'framework:menu-bindings + (lambda (p v) + (let ([mb (get-menu-bar)]) + (let loop ([menu (get-menu-bar)]) + (cond + [(is-a? menu menu-item-container<%>) + (for-each loop (send menu get-items))] + [(is-a? menu selectable-menu-item<%>) + (when (is-a? menu menu:can-restore<%>) + (if v + (send menu restore-keybinding) + (send menu set-shortcut #f)))])))))]) + + (override + [on-close + (lambda () + (remove-prefs-callback) + (super-on-close))]) + + (inherit get-menu-bar show can-close? get-edit-target-object) (sequence (apply super-init args)) ,@(append (map (lambda (x) diff --git a/collects/framework/standard-menus-items.ss b/collects/framework/standard-menus-items.ss index 961c8842..0f35ea4e 100644 --- a/collects/framework/standard-menus-items.ss +++ b/collects/framework/standard-menus-items.ss @@ -72,7 +72,7 @@ "" "defaultly returns" "@link menu")) - (make-generic 'get-menu-item% '(lambda () menu-item%) + (make-generic 'get-menu-item% '(lambda () menu:can-restore-menu-item%) '("The result of this method is used as the class for creating" "the menu items in this class (see " "@link frame:standard-menus" @@ -81,8 +81,9 @@ "@return : (derived-from \\iscmclass{menu-item})" "" "defaultly returns" - "@link menu-item")) - (make-generic 'get-checkable-menu-item% '(lambda () checkable-menu-item%) + "@link menu:can-restore-menu-item %" + ".")) + (make-generic 'get-checkable-menu-item% '(lambda () menu:can-restore-checkable-menu-item%) '("The result of this method is used as the class for creating" "checkable menu items in this class (see " "@link frame:standard-menus" @@ -91,7 +92,8 @@ "@return : (derived-from \\iscmclass{checkable-menu-item})" "" "defaultly returns" - "@link menu-item")) + "@link menu:can-restore-checkable-menu-item %" + ".")) (make-generic 'get-file-menu '(let ([m (make-object (get-menu%)