original commit: 560f9ab944070df14c66fa1a55649b4672465eff
This commit is contained in:
Matthew Flatt 2002-08-22 20:16:57 +00:00
parent 453e92486f
commit f7c2a78bcf
3 changed files with 59 additions and 20 deletions

View File

@ -11,6 +11,8 @@
add-text-keymap-functions
append-editor-font-menu-items
append-editor-operation-menu-items
application-about-handler
application-preferences-handler
area-container-window<%>
area-container<%>
area<%>
@ -34,6 +36,7 @@
control-event%
control<%>
current-eventspace
current-eventspace-has-standard-menus?
current-ps-setup
current-text-keymap-initializer
cursor%
@ -143,6 +146,7 @@
snip-class%
snip-class-list<%>
special-control-key
special-option-key
string-snip%
style-delta%
style-list%

View File

@ -1307,11 +1307,11 @@
(sequence
(apply super-init mred proxy args))))
(define active-frame #f)
(define active-main-frame #f)
(wx:application-file-handler (entry-point
(lambda (f)
(let ([af active-frame])
(let ([af active-main-frame])
(when af
(queue-window-callback
af
@ -1321,19 +1321,44 @@
(wx:application-quit-handler (entry-point
(lambda ()
(let ([l (hash-table-map top-level-windows (lambda (x y) x))])
(for-each
(lambda (f)
(queue-window-callback
f
(entry-point
(lambda ()
(send f on-exit)))))
l)))))
(let ([af active-main-frame])
(when af
(queue-window-callback
af
(entry-point
(lambda ()
(send af on-exit)))))))))
(define application-preferences-handler
(case-lambda
[() (and (wx:main-eventspace? (wx:current-eventspace))
(wx:application-pref-handler))]
[(proc)
(when proc
(unless (and (procedure? proc)
(procedure-arity-includes? proc 0))
(raise-type-error 'application-preferences-handler
"procedure (arity 0) or #f"
proc)))
(when (wx:main-eventspace? (wx:current-eventspace))
(wx:application-pref-handler proc))]))
(define application-about-handler
(case-lambda
[() (or (and (wx:main-eventspace? (wx:current-eventspace))
(wx:application-about-handler))
void)]
[(proc)
(when (wx:main-eventspace? (wx:current-eventspace))
(wx:application-about-handler proc))]))
(define (current-eventspace-has-standard-menus?)
(and (eq? 'macosx (system-type))
(wx:main-eventspace? (wx:current-eventspace))))
(define (make-top-level-window-glue% %) ; implies make-window-glue%
(class100 (make-window-glue% %) (mred proxy . args)
(inherit is-shown? get-mred queue-visible)
(inherit is-shown? get-mred queue-visible get-eventspace)
(rename [super-on-activate on-activate])
(private-field
[act-date/seconds 0] [act-date/milliseconds 0] [act-on? #f])
@ -1362,7 +1387,8 @@
(when on?
(set! act-date/seconds (current-seconds))
(set! act-date/milliseconds (current-milliseconds))
(set! active-frame this))
(when (wx:main-eventspace? (get-eventspace))
(set! active-main-frame this)))
;; Delay callback to handle Windows bug:
(queue-window-callback
this
@ -4931,11 +4957,12 @@
(let ([mb (make-object menu-bar% frame)])
(let ([m (make-object menu% "&File" mb)])
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file #f frame)]) (and f (evaluate (format "(load ~s)" f))))))
(make-object menu-item%
(if (eq? (system-type) 'windows)
"E&xit"
"&Quit")
m (lambda (i e) (send frame on-close) (send frame show #f)) #\q))
(unless (current-eventspace-has-standard-menus?)
(make-object menu-item%
(if (eq? (system-type) 'windows)
"E&xit"
"&Quit")
m (lambda (i e) (send frame on-close) (send frame show #f)) #\q)))
(let ([m (make-object menu% "&Edit" mb)])
(append-editor-operation-menu-items m #f)))
@ -6443,6 +6470,7 @@
snip-class%
snip-class-list<%>
special-control-key
special-option-key
label->plain-label
string-snip%
style<%>
@ -6550,7 +6578,10 @@
timer%
readable-snip<%>
open-input-text-editor
text-editor-load-handler)
text-editor-load-handler
application-about-handler
application-preferences-handler
current-eventspace-has-standard-menus?)
) ;; end of module

View File

@ -1378,8 +1378,11 @@
;; Functions defined in wxscheme.cxx
(define-functions
special-control-key
special-option-key
application-file-handler
application-quit-handler
application-about-handler
application-pref-handler
get-color-from-user
get-font-from-user
get-face-list
@ -1410,7 +1413,8 @@
current-gl-context
send-event
set-snip-class-getter
set-editor-data-class-getter)
set-editor-data-class-getter
main-eventspace?)
)
;; end