Changeset 766


Ignore:
Timestamp:
Apr 8, 2004, 3:49:40 AM (16 years ago)
Author:
gb
Message:

Call #_GetCurrentEventQueue before some other thread calls it ...
Make "void" NSThread early, to tell AppKit? we're multi-threaded.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/objc-runtime.lisp

    r741 r766  
    4343(eval-when (:compile-toplevel :execute)
    4444  #+apple-objc
    45   (use-interface-dir :cocoa)
     45  (progn
     46    (use-interface-dir :cocoa)
     47    (use-interface-dir :carbon))        ; need :carbon for things in this file
    4648  #+gnu-objc
    4749  (use-interface-dir :gnustep))
     
    227229(defloadvar *cocoa-event-process* *initial-process*)
    228230
     231
     232(defun create-void-nsthread ()
     233  ;; Create an NSThread which does nothing but exit.
     234  ;; This'll help to convince the AppKit that we're
     235  ;; multitheaded.  (A lot of other things, including
     236  ;; the ObjC runtime, seem to have already noticed.)
     237  (with-cstrs ((class-name "NSThread")
     238               (message-selector-name "detachNewThreadSelector:toTarget:withObject:")
     239               (exit-selector-name "exit"))
     240    (let* ((nsthread-class (#_objc_lookUpClass class-name))
     241           (message-selector (#_sel_getUid message-selector-name))
     242           (exit-selector (#_sel_getUid exit-selector-name)))
     243      (#_objc_msgSend nsthread-class message-selector
     244                      :address exit-selector
     245                      :address nsthread-class
     246                      :address (%null-ptr))
     247      nil)))
     248
    229249(defun run-in-cocoa-process-and-wait  (f)
    230250  (let* ((process *cocoa-event-process*)
     
    246266       ;; in the thread that's going to process events.  Looking up a
    247267       ;; symbol in the library should cause it to be initialized
    248        (open-shared-library "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")
    249268       (open-shared-library "/System/Library/Frameworks/Cocoa.framework/Cocoa")
    250        (let* ((current (#_CFRunLoopGetCurrent))
    251               (main (external-call "_CFRunLoopGetMain" :address)))
    252          ;; Sadly, it seems that OSX versions > 10.2 only want the
    253          ;; main CFRunLoop to be owned by the initial thread.  I
    254          ;; suppose that we could try to run the event process on that
    255          ;; thread, but that'd require some reorganization.
    256          (or
    257           (eql current main)
    258           (progn (external-call "__CFRunLoopSetCurrent"
    259                                 :address main)
    260                  t))))))
     269       (#_GetCurrentEventQueue)
     270       (create-void-nsthread))))
    261271
    262272
     
    15191529
    15201530(defun class-get-instance-method (class sel)
    1521   #+apple-objc (progn
    1522                  (unless (logtest #$CLS_INITIALIZED (pref (pref class :objc_class.isa)  :objc_class.info))
    1523                    ;; Do this for effect; ignore the :<IMP> it returns.
    1524                    ;; (It should cause the CLS_NEED_BIND flag to turn itself
    1525                    ;; off after the class has been initialized; we need
    1526                    ;; the class and all superclasses to have been initialized,
    1527                    ;; so that we can find category methods via
    1528                    ;; #_class_getInstanceMethod.
    1529                    (external-call "_class_lookupMethod"
    1530                                   :id class
    1531                                   :<SEL> sel
    1532                                   :address))
    1533                  (#_class_getInstanceMethod class sel))
     1531  #+apple-objc (let* ((p (#_class_getInstanceMethod class sel)))
     1532                 (if (%null-ptr-p p)
     1533                   (unless (logtest #$CLS_INITIALIZED (pref (pref class :objc_class.isa)  :objc_class.info))
     1534                     ;; Do this for effect; ignore the :<IMP> it returns.
     1535                     ;; (It should cause the CLS_NEED_BIND flag to turn itself
     1536                     ;; off after the class has been initialized; we need
     1537                     ;; the class and all superclasses to have been initialized,
     1538                     ;; so that we can find category methods via
     1539                     ;; #_class_getInstanceMethod.
     1540                     (external-call "_class_lookupMethod"
     1541                                    :id class
     1542                                    :<SEL> sel
     1543                                    :address)
     1544                     (%setf-macptr p (#_class_getInstanceMethod class sel))))
     1545                 p)
    15341546  #+gnu-objc (#_class_get_instance_method class sel))
    15351547
Note: See TracChangeset for help on using the changeset viewer.