Work around limitations in the way the OS supports filesystem-change-evt
This commit is contained in:
parent
51a28b9349
commit
64cfce2472
|
@ -10,7 +10,9 @@
|
|||
|
||||
(struct file-content (name reader-proc content) #:prefab) ;; ASSERTION
|
||||
|
||||
;; Internal driver ground-level protocol
|
||||
(struct file-changed (name) #:prefab) ;; MESSAGE
|
||||
(struct file-container-changed (parent-path) #:prefab) ;; MESSAGE
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -26,7 +28,13 @@
|
|||
|
||||
(define (track-file name reader-proc)
|
||||
(define control-ch (make-channel))
|
||||
(thread (lambda () (track-file-changes name control-ch)))
|
||||
|
||||
(define parent-path
|
||||
(let-values (((parent-path _leaf _syntactically-dir?)
|
||||
(split-path (path->complete-path name))))
|
||||
parent-path))
|
||||
|
||||
(thread (lambda () (track-file-changes name parent-path control-ch)))
|
||||
|
||||
(field [content (read-file name reader-proc)])
|
||||
|
||||
|
@ -35,9 +43,25 @@
|
|||
(on (message (inbound (file-changed name)))
|
||||
(content (read-file name reader-proc)))
|
||||
|
||||
;; This horrible hack is required to work around limitations in the
|
||||
;; OS's file-change reporting. It seems (?) as if, monitoring both
|
||||
;; "a/b" and "a/", that only the event for "a/" will be fired when
|
||||
;; "a/b" changes. This manifests as follows: if I monitor "a/b" and
|
||||
;; "a/nonexistent", then when "a/b" changes, only "a/nonexistent"'s
|
||||
;; event will fire. Therefore, I've kludged in the
|
||||
;; `file-container-changed` message, which copes with one level of
|
||||
;; directory hierarchy of this problem.
|
||||
;;
|
||||
;; TODO: Consider whether it will actually be required to listen for
|
||||
;; file-container-changed events for ALL recursive parents of the
|
||||
;; path of interest up to the root.
|
||||
;;
|
||||
(on (message (inbound (file-container-changed parent-path)))
|
||||
(content (read-file name reader-proc)))
|
||||
|
||||
(on-stop (channel-put control-ch 'quit)))
|
||||
|
||||
(define (track-file-changes name control-ch)
|
||||
(define (track-file-changes name parent-path control-ch)
|
||||
(let loop ()
|
||||
(sync (handle-evt control-ch
|
||||
(lambda (msg)
|
||||
|
@ -50,13 +74,11 @@
|
|||
;; (log-info "track-file-changes ~v: changed" name)
|
||||
(send-ground-message (file-changed name))
|
||||
(loop)))
|
||||
(let-values (((parent-path _leaf _syntactically-dir?)
|
||||
(split-path (path->complete-path name))))
|
||||
(handle-evt (filesystem-change-evt parent-path)
|
||||
(lambda (_dummy)
|
||||
;; (log-info "track-file-changes ~v: directory changed" name)
|
||||
(send-ground-message (file-changed name))
|
||||
(loop))))))))
|
||||
(handle-evt (filesystem-change-evt parent-path)
|
||||
(lambda (_dummy)
|
||||
;; (log-info "track-file-changes ~v: directory changed" name)
|
||||
(send-ground-message (file-container-changed parent-path))
|
||||
(loop)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
Loading…
Reference in New Issue