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

..

Browse Source 
original commit: 77b4beb32e41a1c5f34aaef7ab39b8715c9b830f
This commit is contained in:
Robby Findler 2003-08-12 19:30:16 +00:00
parent 963d51e9e1
commit 09c8670545
1 changed files with 39 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
collects/framework/private/gen-standard-menus.ss
View File

@ -142,51 +142,45 @@
(pretty-print
`(define standard-menus-mixin
(let ([t 0])
(mixin (basic<%>) (standard-menus<%>)
(inherit on-menu-char on-traverse-char)
(set! t (current-milliseconds))
(define remove-prefs-callback
(preferences:add-callback
'framework:menu-bindings
(lambda (p v)
(let loop ([menu (get-menu-bar)])
(when (is-a? menu menu:can-restore<%>)
(if v
(send menu restore-keybinding)
(send menu set-shortcut #f)))
(when (is-a? menu menu:can-restore-underscore<%>)
(if v
(send menu restore-underscores)
(send menu erase-underscores)))
(when (is-a? menu menu-item-container<%>)
(for-each loop (send menu get-items)))))))
(inherit get-menu-bar show can-close? get-edit-target-object)
,@(apply append (map (lambda (x)
(cond
[(between? x) (build-before-super-between-clause x)]
[(or (after? x) (before? x)) (build-before-super-before/after-clause x)]
[(an-item? x) (build-before-super-item-clause x)]
[(generic? x) (build-before-super-generic-clause x)]
[else (printf "~a~n" x)]))
items))
(printf "before instantiation: ~s\n" (- (current-milliseconds) t))
(super-instantiate ())
(printf "after instantiation: ~s\n" (- (current-milliseconds) t))
,@(apply append (map (lambda (x)
(cond
[(between? x) (build-after-super-between-clause x)]
[(an-item? x) (build-after-super-item-clause x)]
[(or (after? x) (before? x)) (build-after-super-before/after-clause x)]
[(generic? x) (build-after-super-generic-clause x)]))
items))
(reorder-menus this)
(printf "total time: ~s\n" (- (current-milliseconds) t))
)))
(mixin (basic<%>) (standard-menus<%>)
(inherit on-menu-char on-traverse-char)
(set! t (current-milliseconds))
(set! g (current-gc-milliseconds))
(define remove-prefs-callback
(preferences:add-callback
'framework:menu-bindings
(lambda (p v)
(let loop ([menu (get-menu-bar)])
(when (is-a? menu menu:can-restore<%>)
(if v
(send menu restore-keybinding)
(send menu set-shortcut #f)))
(when (is-a? menu menu:can-restore-underscore<%>)
(if v
(send menu restore-underscores)
(send menu erase-underscores)))
(when (is-a? menu menu-item-container<%>)
(for-each loop (send menu get-items)))))))
(inherit get-menu-bar show can-close? get-edit-target-object)
,@(apply append (map (lambda (x)
(cond
[(between? x) (build-before-super-between-clause x)]
[(or (after? x) (before? x)) (build-before-super-before/after-clause x)]
[(an-item? x) (build-before-super-item-clause x)]
[(generic? x) (build-before-super-generic-clause x)]))
items))
(super-instantiate ())
,@(apply append (map (lambda (x)
(cond
[(between? x) (build-after-super-between-clause x)]
[(an-item? x) (build-after-super-item-clause x)]
[(or (after? x) (before? x)) (build-after-super-before/after-clause x)]
[(generic? x) (build-after-super-generic-clause x)]))
items))
(reorder-menus this)))
port))
'text
'truncate))