Changeset 184

Timestamp:

Jan 3, 2004, 11:45:59 AM (21 years ago)

Author:

Gary Byers

Message:

More gnu-objc conditionalization.

File:

• trunk/ccl/examples/objc-support.lisp (modified) (7 diffs)

trunk/ccl/examples/objc-support.lisp

@@ -6 +6 @@
   (require "BRIDGE"))
 
+#+apple-objc
+(progn
 ;;; NSException-handling stuff.
 ;;; First, we have to jump through some hoops so that #_longjmp can
@@ -63 +65 @@
   t)
 
-
+)
 
 (defvar *condition-id-map* (make-id-map) "Map lisp conditions to small integers")
@@ -106 +108 @@
                       :with-lisp-id (assign-id-map-id *condition-id-map* c)))
 
+#+apple-objc
+(progn
 ;;; (#__NSRaiseError nsexception) is entirely equivalent to
 ;;; -[NSException raise].  If we get nervous about passing the former
@@ -119 +123 @@
   nil)
 
-  
+)
 
 (defun open-main-bundle ()
@@ -144 +148 @@
                 (send keys :add-object nextkey)
                 (send values :add-object (send src :object-for-key nextkey)))
-            (when (send nextkey :is-equal-to  newkey)
+            (when (send nextkey :is-equal-to-string  newkey)
               (send keys :add-object nextkey)
               (send values :add-object newval)
@@ -151 +155 @@
                         :with-objects values
                         :for-keys keys)))
-
 
 
@@ -185 +188 @@
          (setq *listener-autorelease-pool* (create-autorelease-pool)))))))
 
+#+apple-objc
 (defun show-autorelease-pools ()
   (send (@class ns-autorelease-pool) 'show-pools))
+
+#+gnu-objc
+(defun show-autorelease-pools ()
+  (do* ((current (objc-message-send (@class ns-autorelease-pool) "currentPool")
+                 (objc-message-send current "_parentAutoreleasePool"))
+        (i 0 (1+ i)))
+       ((%null-ptr-p current) (values))
+    (format t "~& ~d : ~a [~d]"
+            i
+            (nsobject-description current)
+            (pref current :<NSA>utorelease<P>ool._released_count))))
 
 (define-toplevel-command :global sap () "Log information about current thread's autorelease-pool(s) to C's standard error stream"