@@ -18,3 +18,4 @@ GTAGS

 *.old

 nsrect-expose.c

 test.c

+.[#]*

new file mode 100644

@@ -0,0 +1,18 @@

+* Intro

+  

+CCL and LispWorks and other implementations have their own bridges to

+the objective-c runtime.  This project is an attempt to create a

+bridge that only uses CFFI so that arbitrary lisp implementations can

+produce native mac GUIs.  In the long run, I hope to use this as the

+basis for a new mac-native backend for McClim: but we'll see if that

+ever happens.

+

+* Installing

+

+1. clone fwoar.lisputils from

+   https://github.com/fiddlerwoaroof/fwoar.lisputils and put it

+   somewhere quicklisp can find it (e.g. ~/quicklisp/local-projects)

+2. run the demo:

+   #+BEGIN_SRC sh

+make run CCL=/path/to/ccl

+   #+END_SRC

@@ -17,16 +17,25 @@

   (b :char)

   (c :boolean))

+(cffi:defcfun (init-with-frame "initWithFrame")

+    :pointer

+  (thing :pointer)

+  (rect :pointer))

+

 (cffi:defcfun (print-rect "printRect")

     :void

   (rect (:struct objc-runtime::ns-rect)))

-#+null

 (cffi:defcfun (set-uncaught-exception-handler "set_uncaught_exception_handler"

                                               :library objc-runtime::expose-stuff)

     :void

   (cb :pointer))

+(defun value-for-key (thing key)

+  (with-selectors ((vfk "valueForKey:"))

+    (let ((key (make-nsstring key)))

+      [thing vfk :string key])))

+

 (defun call-with-rect (x y w h cb)

   (check-type x real)

   (check-type y real)

@@ -80,8 +89,39 @@

                               ,(coerce h 'double-float)))

                            '(:struct objc-runtime:ns-rect)))

+(defun make-nsstring (str)

+  (with-selectors (alloc (init-with-encoding "initWithCString:length:"))

+    [[#@NSString alloc] init-with-encoding :string str :uint (length str)]))

+

+(defun show-alert (message)

+  (with-selectors ((set-message-text "setMessageText:")

+                   (set-informative-text "setInformativeText:")

+                   (add-button-with-title "addButtonWithTitle:")

+                   (run-modal "runModal")

+                   alloc init)

+    (let ((alert [[#@NSAlert alloc] init]))

+      [alert set-message-text :pointer (make-nsstring message)]

+      [alert set-informative-text :pointer (make-nsstring "Informative text.")]

+      [alert add-button-with-title :pointer (make-nsstring "Cancel")]

+      [alert add-button-with-title :pointer (make-nsstring "OK")]

+      [alert run-modal])))

+

+(cffi:defcallback button-action :void ((a :pointer) (b :pointer) (sender :pointer))

+  (declare (ignore a b sender))

+  (show-alert "Hello There!"))

+

+(defun make-button-delegate (button)

+  (let ((my-class (objc-runtime::objc-allocate-class-pair #@NSObject "ButtonDel" 0)))

+    (with-selectors ((do-magic "doMagic:") (set-target "setTarget:") (set-action "setAction:")

+                     alloc init)

+      (objc-runtime::class-add-method my-class do-magic (cffi:callback button-action)

+                                      "v@:@")

+      (fw.lu:prog1-bind (result [[my-class alloc] init])

+        [button set-target :pointer result]

+        [button set-action :pointer do-magic]))))

+

 (defun main ()

-  (break)

+  ;; (break)

   (trivial-main-thread:with-body-in-main-thread ()

     (with-selectors ((shared-application "sharedApplication")

                      (process-info "processInfo")

@@ -98,6 +138,11 @@

                      (init-with-title "initWithTitle:action:keyEquivalent:")

                      (set-submenu "setSubmenu:")

                      (init-with-encoding "initWithCString:length:")

+                     (content-view "contentView")

+                     (add-subview "addSubview:")

+                     (set-target "setTarget:")

+                     (set-action "setAction:")

+                     (set-title "setTitle:")

                      terminate?

                      ;; (application-should-terminate "applicationShouldTerminate:")

                      ;; (set-delegate "setDelegate:")

@@ -123,12 +168,19 @@

           [objc-runtime::ns-app set-main-menu :pointer menubar] )

         (with-point (p (20 20))

-          (let* ((the-window [#@NSWindow alloc])

-                 (foreign-rect (make-rect 10 10 120 120)))

+          (let* ((foreign-rect (make-rect 10 10 120 120))

+                 (the-window (init-window [#@NSWindow alloc] foreign-rect 1 2 nil))

+                 (the-button (init-with-frame [#@NSButton alloc] (make-rect 10 10 100 100))))

+            (format t "~{~&~a~%~}"

+                    (sort (objc-runtime::get-method-names (objc-runtime::object-get-class [the-window content-view]))

+                          #'string-lessp))

             (format t "~&My rect: ~s~%"

                     (cffi:convert-from-foreign foreign-rect

                                                '(:struct objc-runtime::ns-rect)))

-            (init-window the-window foreign-rect 1 2 nil)

+            

+            [the-button set-title :pointer (make-nsstring "Click me!")]

+            (make-button-delegate the-button)

+            [(value-for-key the-window "contentView") add-subview :pointer the-button]

             [the-window cascade-top-left-from-point :pointer p]

             [the-window set-title :pointer application-name]

             [the-window make-key-and-order-front :pointer (cffi:null-pointer)]

@@ -21,3 +21,6 @@ EXPORT id initWindow(NSWindow *window, NSRect *rect, char a, char b, Boolean c)

                            styleMask: a

                              backing: b

                                defer: c];}

+EXPORT id initWithFrame(id thing, NSRect *rect) {

+  printf("Got a rect: (%f %f), (%f %f)\n", rect->size.width, rect->size.height, rect->origin.x, rect->origin.y);

+  return [thing initWithFrame: *rect];}

@@ -83,6 +83,42 @@

     :string

   (sel o-selector))

+(defcfun (class-get-instance-variable "class_getInstanceVariable" :library foundation)

+    :pointer

+  (cls o-class)

+  (name :string))

+

+(defcfun (class-get-instance-variable "class_addMethod" :library foundation)

+    :pointer

+  (cls o-class)

+  (sel :pointer)

+  (imp :pointer)

+  (type :string))

+

+(defcfun (object-get-class "object_getClass" :library foundation)

+    :pointer

+  (object :pointer))

+

+(defcfun (object-get-ivar "object_getIvar" :library foundation)

+    :pointer

+  (object :pointer)

+  (ivar :pointer))

+

+(defcfun (class-get-property "class_getProperty" :library foundation)

+    :pointer

+  (cls o-class)

+  (name :string))

+

+(defcfun (property-copy-attribute-value "property_copyAttributeValue" :library foundation)

+    :string

+  (prop :pointer)

+  (name :string))

+

+

+(defcfun (property-get-attributes "property_getAttributes" :library foundation)

+    :string

+  (prop :pointer))

+

 (defgeneric get-methods (class)

   (:method ((class string))

     (get-methods (objc-look-up-class class)))

@@ -15,7 +15,8 @@

                           c b

                           (let ((class-name (coerce (loop for c = (read-char s nil nil t)

                                                        until (or (null c)

-                                                                 (serapeum:whitespacep c))

+                                                                 (serapeum:whitespacep c)

+                                                                 (member c '(#\) #\(  #\[ #\])))

                                                        collect c)

                                                     'string)))

                             `(objc-look-up-class ,class-name)))))