diff -ruN /tmp/cl-opengl/glut/callbacks.lisp cl-opengl/glut/callbacks.lisp
--- /tmp/cl-opengl/glut/callbacks.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/callbacks.lisp	2009-07-20 01:46:30.000000000 +0100
@@ -137,12 +137,14 @@
   (poll-interval :int))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutMouseWheelFunc" mouse-wheel-func) :void
   ;; void (*func)(int button, int pressed, int x, int y)
   (callback-pointer :pointer))
 
-;; freeglut ext
-(defcfun ("glutCloseFunc" close-func) :void
+;; freeglut/GLUT.framework ext
+(defcfun (#-darwin "glutCloseFunc"
+          #+darwin "glutWMCloseFunc" close-func) :void
   ;; void (*func)(void)
   (callback-pointer :pointer))
 
@@ -152,6 +154,7 @@
   (callback-pointer :pointer))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutMenuDestroyFunc" menu-destroy-func) :void
   ;; void (*func)(void)
   (callback-pointer :pointer))
diff -ruN /tmp/cl-opengl/glut/fonts.lisp cl-opengl/glut/fonts.lisp
--- /tmp/cl-opengl/glut/fonts.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/fonts.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -107,19 +107,23 @@
   (string :string))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutBitmapHeight" bitmap-height) :int
   (font :pointer))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutStrokeHeight" stroke-height) %gl:float
   (font :pointer))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutBitmapString" bitmap-string) :void
   (font :pointer)
   (string :string))
 
 ;; freeglut ext
+#-darwin
 (defcfun ("glutStrokeString" stroke-string) :void
   (font :pointer)
   (string :string))
\ No newline at end of file
diff -ruN /tmp/cl-opengl/glut/geometry.lisp cl-opengl/glut/geometry.lisp
--- /tmp/cl-opengl/glut/geometry.lisp	2009-07-08 22:19:08.000000000 +0100
+++ cl-opengl/glut/geometry.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -92,33 +92,42 @@
 
 ;;; The following are freeglut extensions:
 
+#-darwin
 (defcfun ("glutWireRhombicDodecahedron" wire-rhombic-dodecahedron) :void)
+
+#-darwin
 (defcfun ("glutSolidRhombicDodecahedron" solid-rhombic-dodecahedron) :void)
 
+#-darwin
 (defcfun ("glutWireSierpinskiSponge" %glutWireSierpinskiSponge) :void
   (num-levels :int)
   (offset-seq :pointer) ; GLdouble offset[3]
   (scale %gl:double))
 
+#-darwin
 (defun wire-sierpinski-sponge (num-levels offset-seq scale)
   (gl::with-opengl-sequence (offset '%gl:double offset-seq)
     (%glutWireSierpinskiSponge num-levels offset scale)))
 
+#-darwin
 (defcfun ("glutSolidSierpinskiSponge" %glutSolidSierpinskiSponge) :void
   (num-levels :int)
   (offset-seq :pointer) ; GLdouble offset[3]
   (scale %gl:double))
 
+#-darwin
 (defun solid-sierpinski-sponge (num-levels offset-seq scale)
   (gl::with-opengl-sequence (offset '%gl:double offset-seq)
     (%glutSolidSierpinskiSponge num-levels offset scale)))
 
+#-darwin
 (defcfun ("glutWireCylinder" wire-cylinder) :void
   (radius %gl:double)
   (height %gl:double)
   (slices %gl:int)
   (stacks %gl:int))
 
+#-darwin
 (defcfun ("glutSolidCylinder" solid-cylinder) :void
   (radius %gl:double)
   (height %gl:double)
diff -ruN /tmp/cl-opengl/glut/init.lisp cl-opengl/glut/init.lisp
--- /tmp/cl-opengl/glut/init.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/init.lisp	2009-07-20 01:48:17.000000000 +0100
@@ -43,21 +43,73 @@
   #-(and sbcl (or x86 x86-64))
   `(progn ,@body))
 
+(defparameter *glut-initialized-p* nil)
+
+#+(and darwin (or
+               openmcl-native-threads
+               sb-thread))
+(defparameter *glut-thread* nil)
+
+(defun make-thread (name function)
+  #+openmcl-native-threads (ccl:process-run-function name function)
+  #+sb-thread (sb-thread:make-thread function :name name)
+  #-(or openmcl-native-threads sb-thread)
+  (error "CL-GLUT::MAKE-THREAD not implemented for this Lisp."))
+
+(defun %init (program-name)
+  (with-foreign-objects ((argcp :int) (argv :pointer))
+    (setf (mem-ref argcp :int) 1)
+    (with-foreign-string (str program-name)
+      (setf (mem-ref argv :pointer) str)
+      (%glutInit argcp argv)
+      (setf *glut-initialized-p* t)))
+  ;; By default, we choose the saner option to return from the event
+  ;; loop on window close instead of exit()ing.
+  (set-action-on-window-close :action-continue-execution)
+  ;; this probably doesn't play well with other toolkits
+  (setq %gl:*gl-get-proc-address* 'get-proc-address)
+  (values))
+
+;;; From CCL's opengl-ffi:
+;;;
+;;; "On OSX, we need to use an undocumented API or two to ensure that
+;;; the thread we're creating is seen as the 'main' event handling
+;;; thread (that's what the code that sets the current thread's
+;;; CFRunLoop to the main CFRunLoop does.)"
+
+#+(and darwin (or sb-thread openmcl-native-threads))
+(progn
+  (defcfun ("CFRunLoopGetCurrent" cf-run-loop-get-current) :pointer)
+  (defcfun ("_CFRunLoopSetCurrent" cf-run-loop-set-current)
+      :pointer (arg :pointer))
+  (defcfun ("CFRunLoopGetMain" cf-run-loop-get-main) :pointer))
+
 (defun init (&optional (program-name (lisp-implementation-type)))
   (without-fp-traps
-    ;; freeglut will exit() if we try to call initGlut() when
-    ;; things are already initialized.
-    (unless (getp :init-state)
-      (with-foreign-objects ((argcp :int) (argv :pointer))
-        (setf (mem-ref argcp :int) 1)
-        (with-foreign-string (str program-name)
-          (setf (mem-ref argv :pointer) str)
-          (%glutInit argcp argv)))
-      ;; By default, we choose the saner option to return from the event
-      ;; loop on window close instead of exit()ing.
-      (set-action-on-window-close :action-continue-execution)
-      ;; this probably doesn't play well with other toolkits
-      (setq %gl:*gl-get-proc-address* 'get-proc-address)))
+   ;; freeglut will exit() if we try to call initGlut() when
+   ;; things are already initialized.
+   (unless *glut-initialized-p*
+     #+(and darwin (or sb-thread openmcl-native-threads))
+     (setf *glut-thread*
+           (make-thread
+            "CL-GLUT thread"
+            (lambda ()
+              ;; In OSX, a "run loop" is a data structure that
+              ;; describes how event-handling code should block for
+              ;; events, timers, and other event sources.  Ensure that
+              ;; this thread has a "current run loop".  (Under some
+              ;; circumstances, there may not yet be a "main" run
+              ;; loop; setting the "current" ensures that a main loop
+              ;; exists.)
+              (cf-run-loop-get-current)
+              ;; Make the current thread's run loop be the "main" one;
+              ;; only the main run loop can interact with the window
+              ;; server.
+              (cf-run-loop-set-current (cf-run-loop-get-main))
+              (%init program-name)
+              (loop (sleep 1)))))
+     #-(and darwin (or sb-thread openmcl-native-threads))
+     (%init program-name)))
   (values))
 
 ;; We call init at load-time in order to ensure a usable glut as often
diff -ruN /tmp/cl-opengl/glut/interface.lisp cl-opengl/glut/interface.lisp
--- /tmp/cl-opengl/glut/interface.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/interface.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -189,7 +189,6 @@
   (mouse-wheel      (window (button mouse-button) (pressed mouse-button-state)
                             (x :int) (y :int)))
   (close            (window))
-  ;; (wm-close         (window)) ; synonym for CLOSE
   (menu-destroy     (window)))
 
 ;;; These two functions should not be called directly and are called
@@ -220,6 +219,7 @@
 (defclass base-window ()
   ((name :reader name :initarg :name :initform (gensym "GLUT-WINDOW"))
    (id   :reader id)
+   (destroyed :accessor destroyed :initform nil)
    (pos-x  :accessor pos-x  :initarg :pos-x)
    (pos-y  :accessor pos-y  :initarg :pos-y)
    (height :accessor height :initarg :height)
@@ -305,40 +305,73 @@
 
 (defmethod enable-event ((window base-window) event-name)
   (let ((event (find-event-or-lose event-name)))
-    (with-window window
-      (register-callback event))
-    (pushnew event (events window))
-    (when (eq event-name :idle)
-      (push window *windows-with-idle-event*))))
+    (when (not (find event (events window)))
+      (with-window window
+        (register-callback event))
+      (push event (events window))
+      (when (eq event-name :idle)
+        (push window *windows-with-idle-event*)))))
+
 
 (defmethod disable-event ((window base-window) event-name)
   (if (eq event-name :display)
       (warn "GLUT would be upset if we set the DISPLAY callback to NULL. ~
              So we won't do that.")
       (let ((event (find-event-or-lose event-name)))
-        ;; We don't actually disable the CLOSE event since we need it
-        ;; for bookkeeping. See the CLOSE methods below.
-        (unless (or (eq event-name :idle) (eq event-name :close))
-          (with-window window
-            (unregister-callback event)))
-        (setf (events window) (delete event (events window)))
-        (when (eq event-name :idle)
-          (setq *windows-with-idle-event*
-                (delete window *windows-with-idle-event*))))))
+        (when (find event (events window))
+          ;; We don't actually disable the CLOSE event since we need it
+          ;; for bookkeeping. See the CLOSE methods below.
+          (unless (or (eq event-name :idle)
+                      (eq event-name :close))
+            (with-window window
+              (unregister-callback event)))
+          (setf (events window) (delete event (events window)))
+          (when (eq event-name :idle)
+            (setq *windows-with-idle-event*
+                  (delete window *windows-with-idle-event*))
+            ;; We need to disable the idle callback here too in addition to close
+            (when (null *windows-with-idle-event*)
+              (unregister-callback event)))))))
 
 (defun destroy-current-window ()
   (when-current-window-exists
-    (if (game-mode current-window)
-        (leave-game-mode)
-        (destroy-window (id current-window)))))
+    (cond
+      ((game-mode current-window)
+       (leave-game-mode))
+      (t
+       (destroy-window (id current-window))
+       #+darwin
+       (progn
+         (setf (destroyed current-window) t)
+         (close current-window))))))
 
 (defmethod close :around ((w base-window))
   (when (member :close (events w) :key #'event-name)
     (call-next-method))
   (setf (aref *id->window* (id w)) nil)
   (setq *windows-with-idle-event* (delete w *windows-with-idle-event*))
+  #+darwin
+  (when (not (destroyed w))
+    (setf (destroyed w) t)
+    (destroy-window (id w)))
   (when (null *windows-with-idle-event*)
-    (unregister-callback (find-event-or-lose :idle))))
+    (unregister-callback (find-event-or-lose :idle)))
+  #+darwin
+  (progn
+    (when (= 0 (length (remove-if #'null *id->window*)))
+      ;; We want to leave the glut event loop if all glut windows are
+      ;; closed, even when :action-continue-execution is set.
+      (leave-main-loop))
+    (ecase *window-close-action*
+      ;; :action-exit is probably unnecessary, as it should never be used.
+      (:action-exit
+       #+sbcl (sb-ext:quit)
+       #+ccl (ccl:quit)
+       #-(or sbcl ccl) (warn "Don't know how to quit."))
+      (:action-glutmainloop-returns
+       (leave-main-loop))
+      (:action-continue-execution
+       nil))))
 
 (defmethod close ((w base-window))
   (values))
@@ -409,24 +442,3 @@
 (defmethod display-window :around ((win sub-window))
   (setf (slot-value win 'id) (create-sub-window (id (parent win)) 0 0 0 0))
   (call-next-method))
-
-;;;; For posterity
-
-;;; "This is quite ugly: OS X is very picky about which thread gets to handle
-;;; events and only allows the main thread to do so. We need to run any event
-;;; loops in the initial thread on multithreaded Lisps, or in this case,
-;;; OpenMCL."
-
-;; #-openmcl
-;; (defun run-event-loop ()
-;;   (glut:main-loop))
-
-;; #+openmcl
-;; (defun run-event-loop ()
-;;   (flet ((start ()
-;;            (ccl:%set-toplevel nil)
-;;            (glut:main-loop)))
-;;     (ccl:process-interrupt ccl::*initial-process*
-;;                            (lambda ()
-;;                              (ccl:%set-toplevel #'start)
-;;                              (ccl:toplevel)))))
diff -ruN /tmp/cl-opengl/glut/library.lisp cl-opengl/glut/library.lisp
--- /tmp/cl-opengl/glut/library.lisp	2009-07-08 22:19:08.000000000 +0100
+++ cl-opengl/glut/library.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -32,9 +32,16 @@
 
 (in-package :cl-glut)
 
+;;; TODO: check what other (threaded) Lisps might need to load this
+;;; framework which is necessary to setup the necessary magic for
+;;; GLUT's main loop. CCL already loads this framework by default.
+(define-foreign-library core-foundation
+  ((:and :darwin :sb-thread) (:framework "CoreFoundation")))
+
 (define-foreign-library glut
-  (:darwin (:or "libglut.dylib" "libglut.3.dylib"))
+  (:darwin (:framework "GLUT"))
   (:windows "freeglut.dll")
   (:unix (:or "libglut.so" "libglut.so.3")))
 
-(use-foreign-library glut)
\ No newline at end of file
+(use-foreign-library glut)
+(use-foreign-library core-foundation)
\ No newline at end of file
diff -ruN /tmp/cl-opengl/glut/main.lisp cl-opengl/glut/main.lisp
--- /tmp/cl-opengl/glut/main.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/main.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -34,11 +34,34 @@
 
 (defcfun ("glutMainLoop" %glutMainLoop) :void)
 
+#+darwin
+(defcfun ("glutCheckLoop" check-loop) :void)
+
+#-darwin
 (defun main-loop ()
   (without-fp-traps
     (%glutMainLoop))
   (init))
 
-(defcfun ("glutMainLoopEvent" main-loop-event) :void)
+#+(and darwin (or openmcl-native-threads sb-thread))
+(defun interrupt-thread (thread function)
+  #+ccl (ccl:process-interrupt thread function)
+  #+sbcl (sb-thread:interrupt-thread thread function))
+
+#+darwin
+(let ((darwin-run-main-loop-p t))
+  (defun main-loop ()
+    (flet ((%loop ()
+             (without-fp-traps
+               (loop while darwin-run-main-loop-p do (check-loop)))
+             (init)
+             (setf darwin-run-main-loop-p t)))
+      #+(or openmcl-native-threads sb-thread)
+      (interrupt-thread *glut-thread* #'%loop)
+      #-(or openmcl-native-threads sb-thread)
+      (%loop)))
+  (defun leave-main-loop ()
+    (setf darwin-run-main-loop-p nil)))
 
-(defcfun ("glutLeaveMainLoop" leave-main-loop) :void)
\ No newline at end of file
+#-darwin (defcfun ("glutMainLoopEvent" main-loop-event) :void)
+#-darwin (defcfun ("glutLeaveMainLoop" leave-main-loop) :void)
diff -ruN /tmp/cl-opengl/glut/misc.lisp cl-opengl/glut/misc.lisp
--- /tmp/cl-opengl/glut/misc.lisp	2009-07-08 22:19:09.000000000 +0100
+++ cl-opengl/glut/misc.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -73,7 +73,8 @@
 (defcfun ("glutGameModeString" game-mode-string) :void
   (string :string))
 
-(defcfun ("glutEnterGameMode" enter-game-mode) :int)
+(defcfun ("glutEnterGameMode" enter-game-mode)
+    #-darwin :int #+darwin :void)
 (defcfun ("glutLeaveGameMode" leave-game-mode) :void)
 
 (defcenum (game-mode-param %gl:enum)
diff -ruN /tmp/cl-opengl/glut/state.lisp cl-opengl/glut/state.lisp
--- /tmp/cl-opengl/glut/state.lisp	2009-07-08 22:19:08.000000000 +0100
+++ cl-opengl/glut/state.lisp	2009-07-20 01:46:31.000000000 +0100
@@ -41,6 +41,8 @@
 
 ;;; Setting Options
 
+(defparameter *window-close-action* nil)
+
 ;; freeglut ext
 (defcenum (options %gl:enum)
   (:init-window-x #x01F4)
@@ -54,10 +56,16 @@
   (:window-cursor #x007A))
 
 ;;; freeglut ext
+#-darwin
 (defcfun ("glutSetOption" set-option) :void
   (option options)
   (value :int))
 
+#+darwin
+(defun set-option (val1 val2)
+  (declare (ignore val1 val2))
+  (warn "GLUT:SET-OPTION not supported in GLUT.framework"))
+
 ;;; Also provide some utility functions around glutSetOption().
 
 ;; freeglut ext
@@ -101,8 +109,10 @@
               (foreign-bitfield-value 'display-mode options)))
 
 (defun set-action-on-window-close (action)
+  #-darwin
   (set-option :action-on-window-close
-              (foreign-enum-value 'window-close-behaviour action)))
+              (foreign-enum-value 'window-close-behaviour action))
+  (setf *window-close-action* action))
 
 (defun set-rendering-context (option)
   (set-option :rendering-context
@@ -156,7 +166,7 @@
   :window-border-width                  ; freeglut ext
   :window-header-height                 ; freeglut ext
   :version                              ; freeglut ext
-  :rendering-context                    ; freeglut ext
+  #-darwin :rendering-context           ; freeglut ext
   :direct-rendering)
 
 (defcfun ("glutGet" get) :int
