Changes between Initial Version and Version 1 of Cocoa/DiskInsertions


Ignore:
Timestamp:
11/06/12 17:41:51 (18 months ago)
Author:
rme
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • Cocoa/DiskInsertions

    v1 v1  
     1{{{ 
     2 
     3(in-package "CCL") 
     4 
     5(eval-when (:load-toplevel :execute) 
     6  (open-shared-library "/System/Library/Frameworks/DiskArbitration.framework/DiskArbitration")) 
     7 
     8(eval-when (:compile-toplevel :load-toplevel :execute) 
     9  (use-interface-dir :cocoa) 
     10  (load "ccl:cocoa-ide;lib;cf-utils")) 
     11 
     12(defcallback disk-appeared (:address disk-ref :address context :void) 
     13  (declare (ignore context)) 
     14  (let* ((dict (external-call "DADiskCopyDescription" :address disk-ref 
     15                              #>CFDictionaryRef))) 
     16    (with-cfstring (key "DAVolumeName") 
     17      (let ((name (#_CFDictionaryGetValue dict key))) 
     18        (format t "~&disk ~s appeared~%" (if (%null-ptr-p name) 
     19                                           "(null)" 
     20                                           (%get-cfstring name))))) 
     21    (#_CFRelease dict))) 
     22 
     23(defcallback disk-disappeared (:address disk-ref :address context :void) 
     24  (declare (ignore context)) 
     25  (let* ((dict (external-call "DADiskCopyDescription" :address disk-ref 
     26                              #>CFDictionaryRef))) 
     27    (with-cfstring (key "DAVolumeName") 
     28      (let ((name (#_CFDictionaryGetValue dict key))) 
     29        (format t "~&disk ~s disappeared~%" (if (%null-ptr-p name) 
     30                                              "(null)" 
     31                                              (%get-cfstring name))))) 
     32    (#_CFRelease dict))) 
     33 
     34(defun disk-watcher () 
     35  (let ((session (external-call "DASessionCreate" 
     36                                :address +null-ptr+ :address))) 
     37    (external-call "DARegisterDiskAppearedCallback" 
     38                   :address session :address +null-ptr+ 
     39                   :address disk-appeared :address +null-ptr+) 
     40    (external-call "DARegisterDiskDisappearedCallback" 
     41                   :address session :address +null-ptr+ 
     42                   :address disk-disappeared :address +null-ptr+) 
     43    (external-call "DASessionScheduleWithRunLoop" 
     44                   :address session 
     45                   :address (#_CFRunLoopGetCurrent) 
     46                   :address #&kCFRunLoopDefaultMode) 
     47    ;; this blocks 
     48    (#_CFRunLoopRun) 
     49    (#_CFRelease session))) 
     50 
     51(defparameter *disk-watcher-run-loop* nil) 
     52 
     53(defun run-disk-watcher () 
     54  (process-run-function "disk watcher" 
     55                        #'(lambda () 
     56                            (setq *disk-watcher-run-loop*  
     57                                  (#_CFRunLoopGetCurrent)) 
     58                            (disk-watcher) 
     59                            (setq *disk-watcher-run-loop* nil)))) 
     60 
     61(defun stop-disk-watcher () 
     62  (#_CFRunLoopStop *disk-watcher-run-loop*)) 
     63 
     64}}}