Got the apple menu to work in cocoa.
This commit is contained in:
Abdulaziz Ghuloum
parent
60f5142143
commit
a2c910d990
|
|
@ -0,0 +1,74 @@
|
|||
#!/usr/bin/env ikarus --r6rs-script
|
||||
|
||||
(import (ikarus) (objc) (Cocoa) (Cocoa helpers))
|
||||
|
||||
(define (nsstring x)
|
||||
[$ [$ NSString alloc]
|
||||
initWithCharactersNoCopy: x
|
||||
length: (string-length x)
|
||||
freeWhenDone: #t])
|
||||
|
||||
(define pool [$ [$ NSAutoreleasePool alloc] init])
|
||||
|
||||
(make-app)
|
||||
[$ NSApplication sharedApplication]
|
||||
|
||||
(define (setup-menu app-name)
|
||||
(define (make-menu title)
|
||||
[$ [$ NSMenu alloc] initWithTitle: (nsstring title)])
|
||||
[$ NSApp setMainMenu: (make-menu "")]
|
||||
(let ([apple-menu (make-menu "")])
|
||||
(define (add-item name key action mod)
|
||||
(let ([x [$ apple-menu
|
||||
addItemWithTitle: (nsstring name)
|
||||
action: (get-selector action)
|
||||
keyEquivalent: (nsstring key)]])
|
||||
(when mod
|
||||
[$ x setKeyEquivalentModifierMask: mod])))
|
||||
(define (add-separator)
|
||||
[$ apple-menu addItem: [$ NSMenuItem separatorItem]])
|
||||
(add-item (string-append "About " app-name) ""
|
||||
"orderFrontStandardAboutPanel:" #f)
|
||||
(add-separator)
|
||||
(add-item (string-append "Hide " app-name) "h" "hide:" #f)
|
||||
(add-item "Hide Others" "h" "hideOtherApplications:"
|
||||
(bitwise-ior NSAlternateKeyMask NSCommandKeyMask))
|
||||
(add-item "Show All" "" "unhideAllApplications:" #f)
|
||||
(add-separator)
|
||||
(add-item (string-append "Quit " app-name) "q" "terminate:" #f)
|
||||
(let ([menu-item
|
||||
[$ [$ NSMenuItem alloc]
|
||||
initWithTitle: (nsstring "")
|
||||
action: #f
|
||||
keyEquivalent: (nsstring "")]])
|
||||
[$ menu-item setSubmenu: apple-menu]
|
||||
[$ [$ NSApp mainMenu] addItem: menu-item]
|
||||
[$ NSApp setAppleMenu: apple-menu]
|
||||
[$ menu-item release])
|
||||
[$ apple-menu release]))
|
||||
|
||||
(setup-menu "Hello Ikarus")
|
||||
|
||||
(define style
|
||||
(bitwise-ior
|
||||
NSTitledWindowMask
|
||||
NSClosableWindowMask
|
||||
NSResizableWindowMask
|
||||
NSMiniaturizableWindowMask))
|
||||
|
||||
(define backing NSBackingStoreBuffered)
|
||||
|
||||
(define win
|
||||
[$ [$ NSWindow alloc]
|
||||
initWithContentRect: '#(#(50 50) #(600 400))
|
||||
styleMask: style
|
||||
backing: backing
|
||||
defer: #f])
|
||||
|
||||
[$ win setTitle: (nsstring "Hello Ikarus")]
|
||||
[$ win makeKeyAndOrderFront: win]
|
||||
|
||||
[$ NSApp run]
|
||||
[$ pool release]
|
||||
|
||||
(printf "back!\n")
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
#!/usr/bin/env ikarus --r6rs-script
|
||||
|
||||
(import (ikarus) (objc) (Cocoa))
|
||||
|
||||
(define pool [$ [$ NSAutoreleasePool alloc] init])
|
||||
|
||||
[$ NSApplication sharedApplication]
|
||||
|
||||
(define style
|
||||
(bitwise-ior
|
||||
NSTitledWindowMask
|
||||
NSClosableWindowMask
|
||||
NSResizableWindowMask
|
||||
NSMiniaturizableWindowMask))
|
||||
|
||||
(define backing NSBackingStoreBuffered)
|
||||
|
||||
(define win
|
||||
[$ [$ NSWindow alloc]
|
||||
initWithContentRect: '#(#(50 50) #(600 400))
|
||||
styleMask: style
|
||||
backing: backing
|
||||
defer: #f])
|
||||
|
||||
(define (nsstring x)
|
||||
[$ [$ NSString alloc]
|
||||
initWithCharactersNoCopy: x
|
||||
length: (string-length x)
|
||||
freeWhenDone: #t])
|
||||
|
||||
[$ win setTitle: (nsstring "Hello Ikarus")]
|
||||
|
||||
[$ win makeKeyAndOrderFront: win]
|
||||
|
||||
[$ NSApp run]
|
||||
[$ pool release]
|
||||
|
|
@ -16,6 +16,8 @@
|
|||
(define-class NSWindow)
|
||||
(define-class NSApplication)
|
||||
(define-class NSString)
|
||||
(define-class NSMenu)
|
||||
(define-class NSMenuItem)
|
||||
(define-object NSApp Cocoa)
|
||||
|
||||
(define NSBorderlessWindowMask #b000000000)
|
||||
|
|
@ -48,5 +50,19 @@
|
|||
(define NSMacOSRomanStringEncoding 30)
|
||||
(define NSProprietaryStringEncoding 65536) ; /* Installation-specific encoding */
|
||||
|
||||
(define NSAlphaShiftKeyMask (sll 1 16))
|
||||
(define NSShiftKeyMask (sll 1 17))
|
||||
(define NSControlKeyMask (sll 1 18))
|
||||
(define NSAlternateKeyMask (sll 1 19))
|
||||
(define NSCommandKeyMask (sll 1 20))
|
||||
(define NSNumericPadKeyMask (sll 1 21))
|
||||
(define NSHelpKeyMask (sll 1 22))
|
||||
(define NSFunctionKeyMask (sll 1 23))
|
||||
(define NSDeviceIndependentModifierFlagsMask #xffff0000)
|
||||
|
||||
|
||||
))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
(library (Cocoa helpers)
|
||||
(export make-app)
|
||||
(import (ikarus) (ikarus system $foreign))
|
||||
|
||||
(define (make-app)
|
||||
(define kProcessTransformToForegroundApplication 1)
|
||||
(define self (dlopen #f))
|
||||
(define get-current-process
|
||||
((make-ffi 'void '(pointer))
|
||||
(dlsym self "GetCurrentProcess")))
|
||||
(define transform-process-type
|
||||
((make-ffi 'void '(pointer sint32))
|
||||
(dlsym self "TransformProcessType")))
|
||||
(define set-front-process
|
||||
((make-ffi 'void '(pointer))
|
||||
(dlsym self "SetFrontProcess")))
|
||||
(let ([p (malloc 16)])
|
||||
(get-current-process p)
|
||||
(transform-process-type p kProcessTransformToForegroundApplication)
|
||||
(set-front-process p)
|
||||
(free p)))
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -1,7 +1,9 @@
|
|||
libstreamsdir=$(pkglibdir)/streams
|
||||
dist_libstreams_DATA=streams/primitive.ss streams/derived.ss
|
||||
libCocoadir=$(pkglibdir)/Cocoa
|
||||
dist_libCocoa_DATA=Cocoa/helpers.ss
|
||||
|
||||
dist_pkglib_DATA= streams.ss match.ss pregexp.ss gl.ss glut.ss \
|
||||
ypsilon-compat.ikarus.ss ypsilon-compat.ypsilon.ss
|
||||
|
||||
ypsilon-compat.ikarus.ss ypsilon-compat.ypsilon.ss \
|
||||
objc.ss Cocoa.ss
|
||||
|
||||
|
|
|
|||
|
|
@ -34,8 +34,9 @@ build_triplet = @build@
|
|||
host_triplet = @host@
|
||||
target_triplet = @target@
|
||||
subdir = lib
|
||||
DIST_COMMON = $(dist_libstreams_DATA) $(dist_pkglib_DATA) \
|
||||
$(srcdir)/Makefile.am $(srcdir)/Makefile.in
|
||||
DIST_COMMON = $(dist_libCocoa_DATA) $(dist_libstreams_DATA) \
|
||||
$(dist_pkglib_DATA) $(srcdir)/Makefile.am \
|
||||
$(srcdir)/Makefile.in
|
||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||
am__aclocal_m4_deps = $(top_srcdir)/configure.ac
|
||||
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
|
||||
|
|
@ -51,11 +52,13 @@ am__vpath_adj = case $$p in \
|
|||
*) f=$$p;; \
|
||||
esac;
|
||||
am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
|
||||
am__installdirs = "$(DESTDIR)$(libstreamsdir)" \
|
||||
"$(DESTDIR)$(pkglibdir)"
|
||||
am__installdirs = "$(DESTDIR)$(libCocoadir)" \
|
||||
"$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"
|
||||
dist_libCocoaDATA_INSTALL = $(INSTALL_DATA)
|
||||
dist_libstreamsDATA_INSTALL = $(INSTALL_DATA)
|
||||
dist_pkglibDATA_INSTALL = $(INSTALL_DATA)
|
||||
DATA = $(dist_libstreams_DATA) $(dist_pkglib_DATA)
|
||||
DATA = $(dist_libCocoa_DATA) $(dist_libstreams_DATA) \
|
||||
$(dist_pkglib_DATA)
|
||||
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
|
||||
ACLOCAL = @ACLOCAL@
|
||||
AMTAR = @AMTAR@
|
||||
|
|
@ -160,8 +163,11 @@ top_builddir = @top_builddir@
|
|||
top_srcdir = @top_srcdir@
|
||||
libstreamsdir = $(pkglibdir)/streams
|
||||
dist_libstreams_DATA = streams/primitive.ss streams/derived.ss
|
||||
libCocoadir = $(pkglibdir)/Cocoa
|
||||
dist_libCocoa_DATA = Cocoa/helpers.ss
|
||||
dist_pkglib_DATA = streams.ss match.ss pregexp.ss gl.ss glut.ss \
|
||||
ypsilon-compat.ikarus.ss ypsilon-compat.ypsilon.ss
|
||||
ypsilon-compat.ikarus.ss ypsilon-compat.ypsilon.ss \
|
||||
objc.ss Cocoa.ss
|
||||
|
||||
all: all-am
|
||||
|
||||
|
|
@ -195,6 +201,23 @@ $(top_srcdir)/configure: $(am__configure_deps)
|
|||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
|
||||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||
install-dist_libCocoaDATA: $(dist_libCocoa_DATA)
|
||||
@$(NORMAL_INSTALL)
|
||||
test -z "$(libCocoadir)" || $(MKDIR_P) "$(DESTDIR)$(libCocoadir)"
|
||||
@list='$(dist_libCocoa_DATA)'; for p in $$list; do \
|
||||
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
|
||||
f=$(am__strip_dir) \
|
||||
echo " $(dist_libCocoaDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(libCocoadir)/$$f'"; \
|
||||
$(dist_libCocoaDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(libCocoadir)/$$f"; \
|
||||
done
|
||||
|
||||
uninstall-dist_libCocoaDATA:
|
||||
@$(NORMAL_UNINSTALL)
|
||||
@list='$(dist_libCocoa_DATA)'; for p in $$list; do \
|
||||
f=$(am__strip_dir) \
|
||||
echo " rm -f '$(DESTDIR)$(libCocoadir)/$$f'"; \
|
||||
rm -f "$(DESTDIR)$(libCocoadir)/$$f"; \
|
||||
done
|
||||
install-dist_libstreamsDATA: $(dist_libstreams_DATA)
|
||||
@$(NORMAL_INSTALL)
|
||||
test -z "$(libstreamsdir)" || $(MKDIR_P) "$(DESTDIR)$(libstreamsdir)"
|
||||
|
|
@ -266,7 +289,7 @@ check-am: all-am
|
|||
check: check-am
|
||||
all-am: Makefile $(DATA)
|
||||
installdirs:
|
||||
for dir in "$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"; do \
|
||||
for dir in "$(DESTDIR)$(libCocoadir)" "$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"; do \
|
||||
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
|
||||
done
|
||||
install: install-am
|
||||
|
|
@ -311,7 +334,7 @@ info: info-am
|
|||
|
||||
info-am:
|
||||
|
||||
install-data-am: install-dist_libstreamsDATA
|
||||
install-data-am: install-dist_libCocoaDATA install-dist_libstreamsDATA
|
||||
|
||||
install-dvi: install-dvi-am
|
||||
|
||||
|
|
@ -345,21 +368,23 @@ ps: ps-am
|
|||
|
||||
ps-am:
|
||||
|
||||
uninstall-am: uninstall-dist_libstreamsDATA uninstall-dist_pkglibDATA
|
||||
uninstall-am: uninstall-dist_libCocoaDATA \
|
||||
uninstall-dist_libstreamsDATA uninstall-dist_pkglibDATA
|
||||
|
||||
.MAKE: install-am install-strip
|
||||
|
||||
.PHONY: all all-am check check-am clean clean-generic distclean \
|
||||
distclean-generic distdir dvi dvi-am html html-am info info-am \
|
||||
install install-am install-data install-data-am \
|
||||
install-dist_libstreamsDATA install-dist_pkglibDATA \
|
||||
install-dvi install-dvi-am install-exec install-exec-am \
|
||||
install-html install-html-am install-info install-info-am \
|
||||
install-man install-pdf install-pdf-am install-ps \
|
||||
install-ps-am install-strip installcheck installcheck-am \
|
||||
installdirs maintainer-clean maintainer-clean-generic \
|
||||
mostlyclean mostlyclean-generic pdf pdf-am ps ps-am uninstall \
|
||||
uninstall-am uninstall-dist_libstreamsDATA \
|
||||
install-dist_libCocoaDATA install-dist_libstreamsDATA \
|
||||
install-dist_pkglibDATA install-dvi install-dvi-am \
|
||||
install-exec install-exec-am install-html install-html-am \
|
||||
install-info install-info-am install-man install-pdf \
|
||||
install-pdf-am install-ps install-ps-am install-strip \
|
||||
installcheck installcheck-am installdirs maintainer-clean \
|
||||
maintainer-clean-generic mostlyclean mostlyclean-generic pdf \
|
||||
pdf-am ps ps-am uninstall uninstall-am \
|
||||
uninstall-dist_libCocoaDATA uninstall-dist_libstreamsDATA \
|
||||
uninstall-dist_pkglibDATA
|
||||
|
||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||
|
|
|
|||
|
|
@ -5,12 +5,12 @@
|
|||
define-class
|
||||
define-object
|
||||
string->char*
|
||||
get-selector
|
||||
$)
|
||||
(import
|
||||
(ikarus)
|
||||
(ikarus system $foreign)
|
||||
(except (ypsilon-compat) format)
|
||||
)
|
||||
(except (ypsilon-compat) format))
|
||||
|
||||
(define ptrsize 4)
|
||||
|
||||
|
|
@ -79,13 +79,15 @@
|
|||
|
||||
(define (bv->u8* x)
|
||||
(let ([n (bytevector-length x)])
|
||||
(let ([p (malloc n)])
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-char p i (bytevector-s8-ref x i))
|
||||
(f (+ i 1))])))))
|
||||
(if (= n 0)
|
||||
(integer->pointer 0)
|
||||
(let ([p (malloc n)])
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-char p i (bytevector-s8-ref x i))
|
||||
(f (+ i 1))]))))))
|
||||
|
||||
|
||||
(define (char*->string x)
|
||||
|
|
@ -301,7 +303,7 @@
|
|||
(error 'symbol->selector "undefined selector" x)))
|
||||
|
||||
|
||||
(define (make-signature str)
|
||||
(define (make-signature method-name str)
|
||||
(define who 'make-signature)
|
||||
(let ([n (string-length str)])
|
||||
(define (scan i c)
|
||||
|
|
@ -376,6 +378,7 @@
|
|||
(define (convert-incoming t x)
|
||||
(case t
|
||||
[(object) (make-object x)]
|
||||
[(char) x]
|
||||
[(void) (void)]
|
||||
[else (error 'convert-incoming "invalid type" t)]))
|
||||
|
||||
|
|
@ -401,6 +404,7 @@
|
|||
[(selector)
|
||||
(cond
|
||||
[(selector? x) (selector-ptr x)]
|
||||
[(not x) (integer->pointer 0)]
|
||||
[else (error 'convert-output "not a selector" x)])]
|
||||
[(object)
|
||||
(cond
|
||||
|
|
@ -449,7 +453,7 @@
|
|||
[else (error 'send-message "not an object" x)])])
|
||||
(unless method
|
||||
(error 'send-message "undefined method" method-name))
|
||||
(let ([sig (make-signature (method-types method))]
|
||||
(let ([sig (make-signature method-name (method-types method))]
|
||||
[mptr (method-pointer method)])
|
||||
(call-with-sig sig mptr (cons* x selector args))))))
|
||||
|
||||
Loading…
Reference in New Issue