Changes between Initial Version and Version 1 of Cocoa/DiskInsertions

Timestamp:

11/06/12 11:41:51 (7 months ago)

Author:

rme

Comment:

--

Cocoa/DiskInsertions

@@ +1 @@
+{{{
+
+(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*))
+
+}}}