@@ -12,3 +12,9 @@ GTAGS

 .*.dSYM

 *.dSYM

 *~

+*.o

+.[#]*[#]

+[#]*

+*.old

+nsrect-expose.c

+test.c

@@ -12,11 +12,15 @@

 (cffi:defcfun (init-window "initWindow")

     :pointer

   (window :pointer)

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

+  (rect :pointer)

   (a :char)

   (b :char)

   (c :boolean))

+(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)

@@ -28,9 +32,9 @@

   (check-type y real)

   (check-type w real)

   (check-type h real)

-  (cffi:with-foreign-object (rect '(:struct ns-rect))

+  (cffi:with-foreign-object (rect '(:struct objc-runtime::ns-rect))

     (cffi:with-foreign-slots (((:pointer ns-rect-origin) (:pointer ns-rect-size))

-                              rect (:struct ns-rect))

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

       (cffi:with-foreign-slots ((ns-point-x ns-point-y) ns-rect-origin (:struct ns-point))

         (setf ns-point-x (coerce x 'double-float)

               ns-point-y (coerce y 'double-float)))

@@ -77,31 +81,53 @@

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

 (defun main ()

+  (break)

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

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

                      (process-info "processInfo")

                      (process-name "processName")

                      (set-activation-policy "setActivationPolicy:")

-                     (init-with-content-rect "initWithContentRect:styleMask:backing:defer:")

+                     ;; (init-with-content-rect "initWithContentRect:styleMask:backing:defer:")

                      (set-title "setTitle:")

                      (run "run")

                      (activate-ignoring-other-apps "activateIgnoringOtherApps:")

-                     alloc

                      (make-key-and-order-front "makeKeyAndOrderFront:")

                      (cascade-top-left-from-point "cascadeTopLeftFromPoint:")

+                     (add-item "addItem:")

+                     (set-main-menu "setMainMenu:")

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

+                     (set-submenu "setSubmenu:")

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

+                     terminate?

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

                      ;; (set-delegate "setDelegate:")

                      ;; (finish-launching "finishLaunching")

+                     alloc new autorelease

                      )

+      [#@NSAutoReleasePool new]

       [#@NSApplication shared-application]

       [objc-runtime::ns-app set-activation-policy :int 0]

       ;; (break)

       (let* ((application-name [[#@NSProcessInfo process-info] process-name]))

+        (let* ((menubar [[#@NSMenu new] autorelease])

+               (app-menu-item [[#@NSMenuItem new] autorelease])

+               (app-menu [[#@NSMenu new] autorelease])

+               (quit-name [[#@NSString alloc] init-with-encoding :string "Quit" :uint 4])

+               (key [[#@NSString alloc] init-with-encoding :string "q" :uint 1])

+               (quit-menu-item

+                [[[#@NSMenuItem alloc] init-with-title :pointer quit-name :pointer terminate? :string key] autorelease]))

+          [menubar add-item :pointer app-menu-item]

+          [app-menu add-item :pointer quit-menu-item]

+          [app-menu-item set-submenu :pointer app-menu]

+          [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)))

-            (format t "~&My rect: ~s~%" (cffi:convert-from-foreign foreign-rect '(:struct objc-runtime::ns-rect)))

+            (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-window cascade-top-left-from-point :pointer p]

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

@@ -6,13 +6,18 @@

 #define EXPORT __attribute__((visibility("default")))

 EXPORT void set_uncaught_exception_handler(NSUncaughtExceptionHandler * _Nullable handler) {

-  NSSetUncaughtExceptionHandler(handler);

-};

+  NSSetUncaughtExceptionHandler(handler);};

+

+EXPORT void printRect(NSRect rect) {

+  printf("Got a rect: (%f %f), (%f %f)\n",

+         rect.size.width,

+         rect.size.height,

+         rect.origin.x,

+         rect.origin.y);}

 EXPORT id initWindow(NSWindow *window, NSRect *rect, char a, char b, Boolean c) {

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

   return [window initWithContentRect: *rect

                            styleMask: a

                              backing: b

-                               defer: c];

-}

+                               defer: c];}

@@ -86,6 +86,16 @@

 (defgeneric get-methods (class)

   (:method ((class string))

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

+

+  #+ccl

+  (:method ((class ccl:macptr))

+    (with-foreign-object (num-methods :int)

+      (let ((methods (class-copy-method-list class num-methods)))

+        (let ((result (list)))

+          (dotimes (n (mem-aref num-methods :int) (nreverse result))

+            (push (mem-aref methods :pointer n)

+                  result))))))

+

   #+sbcl

   (:method ((class sb-sys:system-area-pointer))

     (with-foreign-object (num-methods :int)

@@ -111,8 +121,13 @@

 (defparameter *selector-cache* (make-hash-table :test 'equal))

+(serapeum:eval-always

+  (defun normalize-selector-name (sel-name)

+    (substitute #\: #\? sel-name)))

+

 (defun ensure-selector (name)

-  (alexandria:ensure-gethash name *selector-cache*

+  (alexandria:ensure-gethash name

+                             *selector-cache*

                              (sel-register-name name)))

 (defmacro with-selectors ((&rest selector-specs) &body body)

@@ -120,7 +135,8 @@

                      `(,sym (ensure-selector ,foreign-selector)))

                    (mapcar (fw.lu:glambda (spec)

                              (:method ((spec symbol))

-                               (list spec (string-downcase spec)))

+                               (list spec (normalize-selector-name

+                                           (string-downcase spec))))

                              (:method ((spec cons))

                                (list (car spec) (cadr spec))))

                            selector-specs)))