Bugfixes to examples to make them work with the new framework management
Wed Oct 3 13:42:01 PDT 2007 matley@muppetslab.org
* Bugfixes to examples to make them work with the new framework management
diff -rN -u old-cl-objc/examples/circle-view.lisp new-cl-objc/examples/circle-view.lisp
--- old-cl-objc/examples/circle-view.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/examples/circle-view.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -3,7 +3,7 @@
(in-package "CL-OBJC-EXAMPLES")
-(import-framework "Foundation")
+(import-framework "Foundation" t)
(defun make-range (location length)
(slet ((range ns-range))
@@ -24,9 +24,9 @@
(defun make-nsstring (string)
(invoke (invoke 'ns-string alloc) :init-with-utf8-string string))
-(import-framework "AppKit")
+(import-framework "AppKit" t)
-(import-framework "Cocoa")
+(import-framework "Cocoa" t)
(define-objc-class circle-view ns-view
((center ns-point)
@@ -69,7 +69,7 @@
(declare (ignore rect))
(invoke (invoke 'ns-color white-color) set)
(with-ivar-accessors circle-view
- (ns-rect-fill (invoke self bounds))
+ (cl-objc::ns-rect-fill (invoke self bounds))
(slet* ((glyph-range ns-range (invoke (layout-manager self) :glyph-range-for-text-container (text-container self)))
(used-rect ns-rect (invoke (layout-manager self) :user-rect-for-text-container (text-container self)))
(size ns-size (ns-rect-size used-rect)))
@@ -123,7 +123,7 @@
(define-objc-method :set-color (:return-type :void) ((self circle-view) (color ns-color))
(with-ivar-accessors circle-view
(invoke (text-storage self)
- :add-attribute *ns-foreground-color-attribute-name*
+ :add-attribute cl-objc::*ns-foreground-color-attribute-name*
:value color :range (make-range 0 (invoke (text-storage self) length)))
(invoke self :set-needs-displays t)))
@@ -169,8 +169,8 @@
(let ((timer (invoke
(invoke 'ns-timer :scheduled-timer-with-time-interval (/ 1.0 30) :target self :selector (selector :perform-animation) :user-info objc-nil-class :repeats t)
retain)))
- (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode *ns-modal-panel-run-loop-mode*)
- (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode *ns-event-tracking-run-loop-mode*)
+ (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode cl-objc::*ns-modal-panel-run-loop-mode*)
+ (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode cl-objc::*ns-event-tracking-run-loop-mode*)
(with-ivar-accessors circle-view
(setf (last-time self) (invoke 'ns-date time-interval-since-reference-date)))))
@@ -198,5 +198,7 @@
(defun circle-view ()
(invoke 'ns-application shared-application)
- (invoke 'ns-bundle :load-nib-named (lisp-string-to-nsstring "MainMenu") :owner *nsapp*)
- (invoke *nsapp* run))
\ No newline at end of file
+ (invoke 'ns-bundle
+ :load-nib-named (invoke (invoke 'ns-string alloc) :init-with-utf8-string "MainMenu")
+ :owner cl-objc::*nsapp*)
+ (invoke cl-objc::*nsapp* run))
\ No newline at end of file
diff -rN -u old-cl-objc/examples/converter.lisp new-cl-objc/examples/converter.lisp
--- old-cl-objc/examples/converter.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/examples/converter.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -4,7 +4,7 @@
(import-framework "AppKit")
-(use-objc-framework "Cocoa")
+(import-framework "Cocoa")
(define-objc-class converter ns-object
())
@@ -31,5 +31,5 @@
(defun converter ()
(invoke 'ns-application shared-application)
- (invoke 'ns-bundle :load-nib-named (lisp-string-to-nsstring "MainMenu") :owner *nsapp*)
- (invoke *nsapp* run))
\ No newline at end of file
+ (invoke 'ns-bundle :load-nib-named (lisp-string-to-nsstring "MainMenu") :owner cl-objc::*nsapp*)
+ (invoke cl-objc::*nsapp* run))
\ No newline at end of file
diff -rN -u old-cl-objc/examples/hello-world.lisp new-cl-objc/examples/hello-world.lisp
--- old-cl-objc/examples/hello-world.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/examples/hello-world.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -49,7 +49,7 @@
(adios 'ns-sound
:init-with-contents-of-file (lisp-string-to-nsstring "/System/Library/Sounds/Basso.aiff" )
:by-reference 1))
- (invoke *nsapp* :set-delegate delegate)
+ (invoke cl-objc::*nsapp* :set-delegate delegate)
; setting up window
(with-object win
(:init-with-content-rect frame :style-mask 15 :backing 2 :defer 0)
diff -rN -u old-cl-objc/examples/hello-world.m new-cl-objc/examples/hello-world.m
--- old-cl-objc/examples/hello-world.m 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/examples/hello-world.m 1969-12-31 16:00:00.000000000 -0800
@@ -1,84 +0,0 @@
-#import <Foundation/Foundation.h>
-#import <Appkit/Appkit.h>
-
-@interface AppDelegate : NSObject
-{
-}
-
-- (void)applicationDidFinishLaunching: (id) aNotification;
-- (void)sayHello:(id) sender;
-@end
-
-@implementation AppDelegate
-- (void)applicationDidFinishLaunching: (id) aNotification
-{
- printf("Hello, World!\n");
- fflush(0);
-}
-
-- (void)sayHello: (id) sender
-{
- printf("Hello again, World!\n");
- fflush(0);
-}
-@end
-
-int main()
-{
- id app = [NSApplication sharedApplication];
- id delegate = [[AppDelegate alloc] init];
-
- [NSApp setDelegate: delegate];
-
- id win = [NSWindow alloc];
-
- NSRect frame;
- frame.origin.x = 200.0;
- frame.origin.y = 300.0;
- frame.size.width = 250.0;
- frame.size.height = 100.0;
-
- [win initWithContentRect: frame styleMask: 15 backing: 2 defer: 0];
- [win setTitle: @"Hello World"];
- [win setLevel: 3];
-
- NSRect button_rect;
- button_rect.origin.x = 10.0;
- button_rect.origin.y = 10.0;
- button_rect.size.width = 80.0;
- button_rect.size.height = 80.0;
-
- id hel = [[NSButton alloc] initWithFrame: button_rect];
- [[win contentView] addSubview: hel];
- [hel setBezelStyle: 4];
- [hel setTitle: @"Hello"];
- [hel setTarget: [app delegate]];
- [hel setAction: @selector(sayHello:)];
-
- id beep = [NSSound alloc];
- [beep initWithContentsOfFile: @"/System/Library/Sounds/Tink.Aiff" byReference: 1];
- [hel setSound: beep];
-
- NSRect bye_rect;
- bye_rect.origin.x = 100.0;
- bye_rect.origin.y = 10.0;
- bye_rect.size.width = 80.0;
- bye_rect.size.height = 80.0;
-
- id bye = [[NSButton alloc] initWithFrame: bye_rect];
- [[win contentView] addSubview: bye];
- [bye setBezelStyle: 4];
- [bye setAction: @selector(stop:)];
- [bye setEnabled: 1];
- [bye setTitle: @"Goodbye!"];
-
- id adios = [NSSound alloc];
- [adios initWithContentsOfFile: @"/System/Library/Sounds/Basso.aiff" byReference: 1];
- [bye setSound: adios];
-
- [win display];
- [win orderFrontRegardless];
-
- [app run];
-
-}
diff -rN -u old-cl-objc/src/framework.lisp new-cl-objc/src/framework.lisp
--- old-cl-objc/src/framework.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/framework.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -28,19 +28,25 @@
,@body)
(compile-file ,pathname :verbose nil :print nil)))))
-(defparameter *frameworks* nil "The list of frameworks loaded")
+(defparameter *frameworks* nil "The list of frameworks loaded.
+Each element is a cons with car eq to the short name of the
+framework and cons is wheter or not its clos binding are been
+loaded.")
(defmacro import-framework (framework-name &optional clos)
"Import the ObjC framework FRAMEWORK-NAME. If CLOS or
OBJC-CLOS:*AUTOMATIC-CLOS-BINDINGS-UPDATE* is true then load also
the CLOS bindings."
`(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (member ,framework-name *frameworks* :test #'string-equal)
- (load-framework ,framework-name)
- (load (compile-file-pathname (framework-bindings-pathname ,framework-name 'static)))
- (when (or ,clos objc-clos:*automatic-clos-bindings-update*)
- (load (compile-file-pathname (framework-bindings-pathname ,framework-name 'clos))))
- (pushnew ,framework-name *frameworks* :test #'string-equal))))
+ (flet ((framework-data-eq (el1 el2)
+ (and (string-equal (car el1) (car el2))
+ (eq (cdr el1) (cdr el2)))))
+ (unless (member (cons ,framework-name ,clos) *frameworks* :test #'framework-data-eq)
+ (load-framework ,framework-name)
+ (load (compile-file-pathname (framework-bindings-pathname ,framework-name 'static)))
+ (when (or ,clos objc-clos:*automatic-clos-bindings-update*)
+ (load (compile-file-pathname (framework-bindings-pathname ,framework-name 'clos))))
+ (pushnew (cons ,framework-name ,clos) *frameworks* :test #'framework-data-eq)))))
(defmacro compile-framework ((framework-name &key force (clos-bindings t)) &body other-bindings)
"Create bindings for FRAMEWORK-NAME. Frameworks will be
diff -rN -u old-cl-objc/src/frameworks/generate-frameworks-bindings.lisp new-cl-objc/src/frameworks/generate-frameworks-bindings.lisp
--- old-cl-objc/src/frameworks/generate-frameworks-bindings.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/frameworks/generate-frameworks-bindings.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -20,4 +20,5 @@
(compile-framework ("Cocoa")
(cffi:defcfun "NSApplicationMain" :int
(argc :int)
- (argv :pointer)))
+ (argv :pointer))
+ (cffi:defcvar ("NSApp" *nsapp*) objc-id))
diff -rN -u old-cl-objc/src/lisp-interface.lisp new-cl-objc/src/lisp-interface.lisp
--- old-cl-objc/src/lisp-interface.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/lisp-interface.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -285,7 +285,7 @@
((not (eq objc-nil-class (objc-get-class
,(symbol-to-objc-class-name (second ivar-def)))))
'objc-id)
- (t ',(cadr ivar-def)))))
+ (t ',(cadr ivar-def)))))
`(make-ivar ,(symbols-to-objc-selector (list var-name))
,var-type)))
ivars)))))
diff -rN -u old-cl-objc/src/packages.lisp new-cl-objc/src/packages.lisp
--- old-cl-objc/src/packages.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/packages.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -142,7 +142,8 @@
(defpackage "CL-OBJC-EXAMPLES"
(:use "COMMON-LISP" "CL-OBJC" "OBJC-CFFI" "OBJC-READER" "OBJC-CLOS")
(:export "LISP-HELLO-WORLD"
- "CONVERTER"))
+ "CONVERTER"
+ "CIRCLE-VIEW"))
(defpackage "CL-OBJC-USER"
(:use "COMMON-LISP" "CL-OBJC" "OBJC-CFFI" "OBJC-READER" "OBJC-CLOS"))
diff -rN -u old-cl-objc/src/runtime.lisp new-cl-objc/src/runtime.lisp
--- old-cl-objc/src/runtime.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/runtime.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -74,13 +74,14 @@
"TYPE is the lisp CFFI name. Returns an objc struct definition
if TYPE names a struct, a primitive type if TYPE names a basic C
typedef, else TYPE itself."
- (cond
- ((find-struct-definition type))
- ((and (gethash type cffi::*type-parsers*)
- (eq (class-of (funcall (gethash type cffi::*type-parsers*)))
- (find-class 'cffi::foreign-typedef)))
- (cffi::type-keyword (cffi::actual-type (funcall (gethash type cffi::*type-parsers*)))))
- (t type)))
+ (let ((interned-type (intern (symbol-name type) "CL-OBJC")))
+ (cond
+ ((find-struct-definition interned-type))
+ ((and (gethash interned-type cffi::*type-parsers*)
+ (eq (class-of (funcall (gethash interned-type cffi::*type-parsers*)))
+ (find-class 'cffi::foreign-typedef)))
+ (cffi::type-keyword (cffi::actual-type (funcall (gethash interned-type cffi::*type-parsers*)))))
+ (t type))))
(defmacro add-objc-method ((name class &key (return-type 'objc-id) (class-method nil))
argument-list &body body)
diff -rN -u old-cl-objc/src/structs.lisp new-cl-objc/src/structs.lisp
--- old-cl-objc/src/structs.lisp 2014-07-30 02:04:23.000000000 -0700
+++ new-cl-objc/src/structs.lisp 2014-07-30 02:04:23.000000000 -0700
@@ -156,9 +156,9 @@
collect `(mem-aref ,name :int ,i))
when (not struct-def) nconc (list name)))
(lisp-args (mapcar #'car args)))
- (if has-struct-arg
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options name-and-options)
+ (multiple-value-bind (lisp-name foreign-name)
+ (cffi::parse-name-and-options name-and-options)
+ (if has-struct-arg
(let* ((new-name (intern (format nil "SPLAYED-~a" lisp-name)))
(stret (gensym "STRET-"))
(stret-val (gensym))
@@ -184,8 +184,11 @@
((big-struct-type-p has-struct-return)
`(let ((,stret-val (cffi:foreign-alloc ,return-type)))
(,new-name ,stret-val ,@dereferenced-args)))
- (t (error "Struct nor small neither big?That shouldn't happen")))))))
- `(cffi:defcfun ,name-and-options ,return-type ,@doc-and-args))))
+ (t (error "Struct nor small neither big?That shouldn't happen"))))
+ (export ',lisp-name)))
+ `(progn
+ (cffi:defcfun ,name-and-options ,return-type ,@doc-and-args)
+ (export ',lisp-name))))))
(defmacro define-objc-struct (name-and-objc-options &body doc-and-slots)
"Wrapper for CFFI:DEFCSTRUCT allowing struct to be used as