no message
original commit: 2711ca7727891e9e99871a9fe0267ab1e8138d6b
This commit is contained in:
parent
62aa9de612
commit
c8e89dfd65
|
@ -1,7 +1,3 @@
|
||||||
#!/bin/sh
|
|
||||||
|
|
||||||
string=? ; exec mred -qr $0
|
|
||||||
|
|
||||||
(module gen-standard-menus mzscheme
|
(module gen-standard-menus mzscheme
|
||||||
(require (lib "pretty.ss"))
|
(require (lib "pretty.ss"))
|
||||||
(require (lib "list.ss"))
|
(require (lib "list.ss"))
|
||||||
|
@ -60,14 +56,15 @@ string=? ; exec mred -qr $0
|
||||||
`(private-field
|
`(private-field
|
||||||
[,(an-item->item-name item)
|
[,(an-item->item-name item)
|
||||||
(and (,create-menu-item-name)
|
(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])
|
(rename [super-on-demand on-demand])
|
||||||
(override on-demand)
|
(override
|
||||||
(define (on-demand)
|
[on-demand
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(,(an-item->on-demand-name item) this)
|
(,(an-item->on-demand-name item) this)
|
||||||
(super-on-demand)))
|
(super-on-demand))])
|
||||||
(apply super-init args))
|
(sequence
|
||||||
|
(apply super-init args)))
|
||||||
,(join menu-before-string menu-after-string
|
,(join menu-before-string menu-after-string
|
||||||
`(,(an-item->string-name item)))
|
`(,(an-item->string-name item)))
|
||||||
,(menu-item-menu-name item)
|
,(menu-item-menu-name item)
|
||||||
|
|
|
@ -9,29 +9,29 @@
|
||||||
(provide menu@)
|
(provide menu@)
|
||||||
|
|
||||||
(define menu@
|
(define menu@
|
||||||
(unit/sig framework:menu^
|
(unit/sig framework:menu^
|
||||||
(import mred^
|
(import mred^
|
||||||
[preferences : framework:preferences^])
|
[preferences : framework:preferences^])
|
||||||
|
|
||||||
(define can-restore<%>
|
(define can-restore<%>
|
||||||
(interface (selectable-menu-item<%>)
|
(interface (selectable-menu-item<%>)
|
||||||
restore-keybinding))
|
restore-keybinding))
|
||||||
|
|
||||||
(define can-restore-mixin
|
(define can-restore-mixin
|
||||||
(mixin (selectable-menu-item<%>) (can-restore<%>) args
|
(mixin (selectable-menu-item<%>) (can-restore<%>) args
|
||||||
(inherit set-shortcut get-shortcut)
|
(inherit set-shortcut get-shortcut)
|
||||||
(private-field
|
(private-field
|
||||||
[saved-shortcut 'not-yet])
|
[saved-shortcut 'not-yet])
|
||||||
(public
|
(public
|
||||||
[restore-keybinding
|
[restore-keybinding
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(unless (eq? saved-shortcut 'not-yet)
|
(unless (eq? saved-shortcut 'not-yet)
|
||||||
(set-shortcut saved-shortcut)))])
|
(set-shortcut saved-shortcut)))])
|
||||||
(sequence
|
(sequence
|
||||||
(apply super-init args)
|
(apply super-init args)
|
||||||
(set! saved-shortcut (get-shortcut))
|
(set! saved-shortcut (get-shortcut))
|
||||||
(unless (preferences:get 'framework:menu-bindings)
|
(unless (preferences:get 'framework:menu-bindings)
|
||||||
(set-shortcut #f)))))
|
(set-shortcut #f)))))
|
||||||
|
|
||||||
(define can-restore-menu-item% (can-restore-mixin menu-item%))
|
(define can-restore-menu-item% (can-restore-mixin menu-item%))
|
||||||
(define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%)))))
|
(define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%)))))
|
|
@ -2,7 +2,7 @@
|
||||||
(require (lib "unitsig.ss")
|
(require (lib "unitsig.ss")
|
||||||
(lib "class.ss")
|
(lib "class.ss")
|
||||||
(lib "class100.ss")
|
(lib "class100.ss")
|
||||||
"sig"
|
"sig.ss"
|
||||||
"../macro.ss"
|
"../macro.ss"
|
||||||
"../gui-utils-sig.ss"
|
"../gui-utils-sig.ss"
|
||||||
(lib "mred-sig.ss" "mred")
|
(lib "mred-sig.ss" "mred")
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
#|
|
|
||||||
|
|
||||||
(define (test-creation name class-expression)
|
(define (test-creation name class-expression)
|
||||||
(test
|
(test
|
||||||
name
|
name
|
||||||
|
@ -138,8 +136,6 @@
|
||||||
(test-open "frame:searchable open" 'frame:searchable%)
|
(test-open "frame:searchable open" 'frame:searchable%)
|
||||||
(test-open "frame:text-info open" 'frame:text-info-file%)
|
(test-open "frame:text-info open" 'frame:text-info-file%)
|
||||||
|
|
||||||
|#
|
|
||||||
|
|
||||||
(test
|
(test
|
||||||
"set!-ing menu callback in standard-menus-frame"
|
"set!-ing menu callback in standard-menus-frame"
|
||||||
(lambda (x) (eq? x 'passed))
|
(lambda (x) (eq? x 'passed))
|
||||||
|
|
|
@ -7,11 +7,13 @@
|
||||||
(test
|
(test
|
||||||
(string->symbol file)
|
(string->symbol file)
|
||||||
void?
|
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)])
|
(parameterize ([current-namespace (make-namespace)])
|
||||||
(namespace-attach-module
|
(namespace-attach-module
|
||||||
orig-namespace
|
orig-namespace
|
||||||
((current-module-name-resolver) '(lib "mred.ss" "mred")))
|
mred-name)
|
||||||
(eval '(require (lib ,file "framework")))
|
(eval '(require (lib ,file "framework")))
|
||||||
(with-handlers ([(lambda (x) #t)
|
(with-handlers ([(lambda (x) #t)
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
(require (lib "launcher.ss" "launcher")
|
(require (lib "launcher.ss" "launcher")
|
||||||
(lib "pretty.ss")
|
(lib "pretty.ss")
|
||||||
(lib "list.ss")
|
(lib "list.ss")
|
||||||
|
(lib "process.ss")
|
||||||
"debug.ss")
|
"debug.ss")
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
|
|
Loading…
Reference in New Issue
Block a user