(in-package "CCL")

(eval-when (:load-toplevel :execute)
  (open-shared-library "/System/Library/Frameworks/DiskArbitration.framework/DiskArbitration"))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-interface-dir :cocoa)
  (load "ccl:cocoa-ide;lib;cf-utils"))

(defcallback disk-appeared (:address disk-ref :address context :void)
  (declare (ignore context))
  (let* ((dict (external-call "DADiskCopyDescription" :address disk-ref
			      #>CFDictionaryRef)))
    (with-cfstring (key "DAVolumeName")
      (let ((name (#_CFDictionaryGetValue dict key)))
	(format t "~&disk ~s appeared~%" (if (%null-ptr-p name)
					   "(null)"
					   (%get-cfstring name)))))
    (#_CFRelease dict)))

(defcallback disk-disappeared (:address disk-ref :address context :void)
  (declare (ignore context))
  (let* ((dict (external-call "DADiskCopyDescription" :address disk-ref
			      #>CFDictionaryRef)))
    (with-cfstring (key "DAVolumeName")
      (let ((name (#_CFDictionaryGetValue dict key)))
	(format t "~&disk ~s disappeared~%" (if (%null-ptr-p name)
					      "(null)"
					      (%get-cfstring name)))))
    (#_CFRelease dict)))

(defun disk-watcher ()
  (let ((session (external-call "DASessionCreate"
				:address +null-ptr+ :address)))
    (external-call "DARegisterDiskAppearedCallback"
		   :address session :address +null-ptr+
		   :address disk-appeared :address +null-ptr+)
    (external-call "DARegisterDiskDisappearedCallback"
		   :address session :address +null-ptr+
		   :address disk-disappeared :address +null-ptr+)
    (external-call "DASessionScheduleWithRunLoop"
		   :address session
		   :address (#_CFRunLoopGetCurrent)
		   :address #&kCFRunLoopDefaultMode)
    ;; this blocks
    (#_CFRunLoopRun)
    (#_CFRelease session)))

(defparameter *disk-watcher-run-loop* nil)

(defun run-disk-watcher ()
  (process-run-function "disk watcher"
			#'(lambda ()
			    (setq *disk-watcher-run-loop* 
				  (#_CFRunLoopGetCurrent))
			    (disk-watcher)
			    (setq *disk-watcher-run-loop* nil))))

(defun stop-disk-watcher ()
  (#_CFRunLoopStop *disk-watcher-run-loop*))