2008-09-27 01:55:06 -04:00
|
|
|
(library (Cocoa helpers)
|
2008-09-27 03:20:24 -04:00
|
|
|
(export make-app nsstring)
|
|
|
|
(import (ikarus) (Cocoa) (objc) (ikarus system $foreign))
|
2008-09-27 01:55:06 -04:00
|
|
|
|
|
|
|
(define (make-app)
|
|
|
|
(define kProcessTransformToForegroundApplication 1)
|
2008-10-06 01:19:27 -04:00
|
|
|
(define self (dlopen))
|
2008-09-27 01:55:06 -04:00
|
|
|
(define get-current-process
|
2008-10-12 02:06:25 -04:00
|
|
|
((make-c-callout 'void '(pointer))
|
2008-09-27 01:55:06 -04:00
|
|
|
(dlsym self "GetCurrentProcess")))
|
|
|
|
(define transform-process-type
|
2008-10-12 02:06:25 -04:00
|
|
|
((make-c-callout 'void '(pointer signed-int))
|
2008-09-27 01:55:06 -04:00
|
|
|
(dlsym self "TransformProcessType")))
|
|
|
|
(define set-front-process
|
2008-10-12 02:06:25 -04:00
|
|
|
((make-c-callout 'void '(pointer))
|
2008-09-27 01:55:06 -04:00
|
|
|
(dlsym self "SetFrontProcess")))
|
|
|
|
(let ([p (malloc 16)])
|
|
|
|
(get-current-process p)
|
|
|
|
(transform-process-type p kProcessTransformToForegroundApplication)
|
|
|
|
(set-front-process p)
|
|
|
|
(free p)))
|
2008-09-27 03:20:24 -04:00
|
|
|
|
|
|
|
|
|
|
|
(define (nsstring x)
|
|
|
|
[$ [$ NSString alloc]
|
|
|
|
initWithCharactersNoCopy: x
|
|
|
|
length: (string-length x)
|
|
|
|
freeWhenDone: #t])
|
|
|
|
|
2008-09-27 01:55:06 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
|