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

.

Browse Source 
original commit: ab779e89fa3bf6970ccd338872cabfcb747ff23e
This commit is contained in:
Matthew Flatt 1998-11-28 04:56:16 +00:00
parent b067200d0a
commit a8c01cc156
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/mred/wrap/mred.ss
View File

@ -2639,9 +2639,10 @@
(send wx set-title (if l (wx:label->plain-label l) "")) (send wx set-title (if l (wx:label->plain-label l) ""))
(super-set-label l)))]) (super-set-label l)))])
(public (public
[on-traverse-char (lambda (e) [on-traverse-char (entry-point-1
(check-instance '(method top-level-window<%> on-traverse-char) wx:key-event% 'key-event% #f e) (lambda (e)
(send wx handle-traverse-key e))] (check-instance '(method top-level-window<%> on-traverse-char) wx:key-event% 'key-event% #f e)
(send wx handle-traverse-key e)))]
[get-eventspace (entry-point (lambda () (ivar wx eventspace)))] [get-eventspace (entry-point (lambda () (ivar wx eventspace)))]
[can-close? (lambda () #t)] [can-close? (lambda () #t)]
[can-exit? (lambda () (can-close?))] [can-exit? (lambda () (can-close?))]
@ -2728,15 +2729,15 @@
[wx #f] [wx #f]
[status-line? #f]) [status-line? #f])
(override (override
[on-subwindow-char (entry-point-2 [on-subwindow-char (lambda (w event)
(lambda (w event) (super-on-subwindow-char w event)
(super-on-subwindow-char w event) (or (on-menu-char event)
(or (on-menu-char event) (on-traverse-char event)))])
(on-traverse-char event))))])
(public (public
[on-menu-char (lambda (e) [on-menu-char (entry-point-1
(check-instance '(method frame% on-menu-char) wx:key-event% 'key-event% #f e) (lambda (e)
(send wx handle-menu-key e))] (check-instance '(method frame% on-menu-char) wx:key-event% 'key-event% #f e)
(send wx handle-menu-key e)))]
[create-status-line (entry-point (lambda () (unless status-line? (send wx create-status-line) (set! status-line? #t))))] [create-status-line (entry-point (lambda () (unless status-line? (send wx create-status-line) (set! status-line? #t))))]
[set-status-text (entry-point-1 (lambda (s) (send wx set-status-text s)))] [set-status-text (entry-point-1 (lambda (s) (send wx set-status-text s)))]
[has-status-line? (lambda () status-line?)] [has-status-line? (lambda () status-line?)]
@ -2769,9 +2770,9 @@
(rename [super-on-subwindow-char on-subwindow-char]) (rename [super-on-subwindow-char on-subwindow-char])
(private [wx #f]) (private [wx #f])
(override (override
[on-subwindow-char (entry-point-2 (lambda (w event) [on-subwindow-char (lambda (w event)
(super-on-subwindow-char w event) (super-on-subwindow-char w event)
(on-traverse-char event)))]) (on-traverse-char event))])
(sequence (sequence
(as-entry (as-entry
(lambda () (lambda ()
@ -3373,7 +3374,7 @@
[disabled? #f] [disabled? #f]
[keymap (make-object wx:keymap%)]) [keymap (make-object wx:keymap%)])
(public (public
[handle-key (lambda (event) (send keymap handle-key-event this event))] [handle-key (lambda (event) (as-exit (lambda () (send keymap handle-key-event this event))))]
[get-mred (lambda () mred)] [get-mred (lambda () mred)]
[get-items (lambda () items)] [get-items (lambda () items)]
[append-item (lambda (item menu title) [append-item (lambda (item menu title)
@ -3618,6 +3619,7 @@
[keymap (and key-binding [keymap (and key-binding
(let ([keymap (make-object wx:keymap%)]) (let ([keymap (make-object wx:keymap%)])
(send keymap add-key-function "menu-item" (send keymap add-key-function "menu-item"
;; keymap function callback already in exit mode:
(lambda (edit event) (lambda (edit event)
(callback this (make-object wx:control-event% 'menu)))) (callback this (make-object wx:control-event% 'menu))))
(send keymap map-function key-binding "menu-item") (send keymap map-function key-binding "menu-item")