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
|
(struct file-content (name reader-proc content) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; Internal driver ground-level protocol
|
||||||
(struct file-changed (name) #:prefab) ;; MESSAGE
|
(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 (track-file name reader-proc)
|
||||||
(define control-ch (make-channel))
|
(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)])
|
(field [content (read-file name reader-proc)])
|
||||||
|
|
||||||
|
@ -35,9 +43,25 @@
|
||||||
(on (message (inbound (file-changed name)))
|
(on (message (inbound (file-changed name)))
|
||||||
(content (read-file name reader-proc)))
|
(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)))
|
(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 ()
|
(let loop ()
|
||||||
(sync (handle-evt control-ch
|
(sync (handle-evt control-ch
|
||||||
(lambda (msg)
|
(lambda (msg)
|
||||||
|
@ -50,13 +74,11 @@
|
||||||
;; (log-info "track-file-changes ~v: changed" name)
|
;; (log-info "track-file-changes ~v: changed" name)
|
||||||
(send-ground-message (file-changed name))
|
(send-ground-message (file-changed name))
|
||||||
(loop)))
|
(loop)))
|
||||||
(let-values (((parent-path _leaf _syntactically-dir?)
|
(handle-evt (filesystem-change-evt parent-path)
|
||||||
(split-path (path->complete-path name))))
|
(lambda (_dummy)
|
||||||
(handle-evt (filesystem-change-evt parent-path)
|
;; (log-info "track-file-changes ~v: directory changed" name)
|
||||||
(lambda (_dummy)
|
(send-ground-message (file-container-changed parent-path))
|
||||||
;; (log-info "track-file-changes ~v: directory changed" name)
|
(loop)))))))
|
||||||
(send-ground-message (file-changed name))
|
|
||||||
(loop))))))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue