fix focus problems and implement send-message-to-window in cocoa
This commit is contained in:
parent
955df62409
commit
2a4ea2ef98
|
@ -91,6 +91,8 @@ get-font-from-user
|
||||||
get-page-setup-from-user
|
get-page-setup-from-user
|
||||||
get-panel-background
|
get-panel-background
|
||||||
get-ps-setup-from-user
|
get-ps-setup-from-user
|
||||||
|
get-highlight-background-color
|
||||||
|
get-highlight-text-color
|
||||||
get-resource
|
get-resource
|
||||||
get-text-from-user
|
get-text-from-user
|
||||||
get-the-editor-data-class-list
|
get-the-editor-data-class-list
|
||||||
|
|
|
@ -16,12 +16,13 @@
|
||||||
(unsafe!)
|
(unsafe!)
|
||||||
(objc-unsafe!)
|
(objc-unsafe!)
|
||||||
|
|
||||||
(provide frame%)
|
(provide frame%
|
||||||
|
location->window)
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(import-class NSWindow NSGraphicsContext NSMenu NSPanel
|
(import-class NSWindow NSGraphicsContext NSMenu NSPanel
|
||||||
NSApplication NSAutoreleasePool)
|
NSApplication NSAutoreleasePool NSScreen)
|
||||||
|
|
||||||
(define front #f)
|
(define front #f)
|
||||||
|
|
||||||
|
@ -30,6 +31,8 @@
|
||||||
|
|
||||||
(define dialog-level-counter 0)
|
(define dialog-level-counter 0)
|
||||||
|
|
||||||
|
(define all-windows (make-hash))
|
||||||
|
|
||||||
(define-objc-mixin (MyWindowMethods Superclass)
|
(define-objc-mixin (MyWindowMethods Superclass)
|
||||||
[wxb]
|
[wxb]
|
||||||
[-a _scheme (getEventspace)
|
[-a _scheme (getEventspace)
|
||||||
|
@ -242,6 +245,10 @@
|
||||||
[root-fake-frame (send root-fake-frame install-mb)]
|
[root-fake-frame (send root-fake-frame install-mb)]
|
||||||
[else (void)]))))
|
[else (void)]))))
|
||||||
(register-frame-shown this on?)
|
(register-frame-shown this on?)
|
||||||
|
(let ([num (tell #:type _NSInteger cocoa windowNumber)])
|
||||||
|
(if on?
|
||||||
|
(hash-set! all-windows num this)
|
||||||
|
(hash-remove! all-windows num)))
|
||||||
(when on?
|
(when on?
|
||||||
(let ([b (eventspace-wait-cursor-count (get-eventspace))])
|
(let ([b (eventspace-wait-cursor-count (get-eventspace))])
|
||||||
(set-wait-cursor-mode (not (zero? b))))))))
|
(set-wait-cursor-mode (not (zero? b))))))))
|
||||||
|
@ -436,3 +443,13 @@
|
||||||
|
|
||||||
(define/public (set-title s)
|
(define/public (set-title s)
|
||||||
(tellv cocoa setTitle: #:type _NSString s))))
|
(tellv cocoa setTitle: #:type _NSString s))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
(define (location->window x y)
|
||||||
|
(let ([n (tell #:type _NSInteger NSWindow
|
||||||
|
windowNumberAtPoint: #:type _NSPoint
|
||||||
|
(let ([f (tell #:type _NSRect (tell NSScreen mainScreen) frame)])
|
||||||
|
(make-NSPoint x (- (NSSize-height (NSRect-size f)) y)))
|
||||||
|
belowWindowWithWindowNumber: #:type _NSInteger 0)])
|
||||||
|
(atomically (hash-ref all-windows n #f))))
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
ffi/unsafe/objc
|
ffi/unsafe/objc
|
||||||
"utils.rkt"
|
"utils.rkt"
|
||||||
"types.rkt"
|
"types.rkt"
|
||||||
|
"frame.rkt"
|
||||||
"../../lock.rkt"
|
"../../lock.rkt"
|
||||||
"../common/handlers.rkt")
|
"../common/handlers.rkt")
|
||||||
|
|
||||||
|
@ -25,7 +26,6 @@
|
||||||
shortcut-visible-in-label?
|
shortcut-visible-in-label?
|
||||||
in-atomic-region
|
in-atomic-region
|
||||||
set-menu-tester
|
set-menu-tester
|
||||||
location->window
|
|
||||||
set-dialogs
|
set-dialogs
|
||||||
set-executer
|
set-executer
|
||||||
send-event
|
send-event
|
||||||
|
@ -74,7 +74,6 @@
|
||||||
(define-unimplemented in-atomic-region)
|
(define-unimplemented in-atomic-region)
|
||||||
(define (set-menu-tester proc)
|
(define (set-menu-tester proc)
|
||||||
(void))
|
(void))
|
||||||
(define-unimplemented location->window)
|
|
||||||
(define (set-dialogs . args)
|
(define (set-dialogs . args)
|
||||||
(void))
|
(void))
|
||||||
(define (set-executer proc)
|
(define (set-executer proc)
|
||||||
|
|
|
@ -319,7 +319,10 @@
|
||||||
(with-autorelease
|
(with-autorelease
|
||||||
(tellv cocoa removeFromSuperview)))
|
(tellv cocoa removeFromSuperview)))
|
||||||
(set! is-on? (and on? #t))))
|
(set! is-on? (and on? #t))))
|
||||||
(maybe-register-as-child parent on?))
|
(maybe-register-as-child parent on?)
|
||||||
|
(unless on?
|
||||||
|
(focus-is-on #f)
|
||||||
|
(is-responder this #f)))
|
||||||
(define/public (maybe-register-as-child parent on?)
|
(define/public (maybe-register-as-child parent on?)
|
||||||
(void))
|
(void))
|
||||||
(define/public (register-as-child parent on?)
|
(define/public (register-as-child parent on?)
|
||||||
|
|
|
@ -220,4 +220,4 @@
|
||||||
(define/override (on-scroll e)
|
(define/override (on-scroll e)
|
||||||
(editor-canvas-on-scroll))
|
(editor-canvas-on-scroll))
|
||||||
(super-new)
|
(super-new)
|
||||||
(set-no-expose-focus))))
|
#;(set-no-expose-focus))))
|
||||||
|
|
|
@ -13,7 +13,6 @@
|
||||||
(ffi-lib "libpango-1.0.0")]
|
(ffi-lib "libpango-1.0.0")]
|
||||||
[(unix) (ffi-lib "libpango-1.0" '("0"))]
|
[(unix) (ffi-lib "libpango-1.0" '("0"))]
|
||||||
[(windows)
|
[(windows)
|
||||||
; (ffi-lib "msjava")
|
|
||||||
(ffi-lib "libglib-2.0-0")
|
(ffi-lib "libglib-2.0-0")
|
||||||
(ffi-lib "libgmodule-2.0-0")
|
(ffi-lib "libgmodule-2.0-0")
|
||||||
(ffi-lib "libgobject-2.0-0")
|
(ffi-lib "libgobject-2.0-0")
|
||||||
|
|
Loading…
Reference in New Issue
Block a user