Commits

Anonymous committed 898f45d

added guard-like

Comments (0)

Files changed (1)

+(use posix srfi-69)
+
+(define (monitor-loop directory)
+  (let loop ((agenda (make-hash-table string=?)))
+    (sleep 1)
+    (loop (run-monitor directory agenda (notify-changed-handler debug-events)))))
+
+(define (run-monitor directory agenda handler)
+  (find-files directory seed: agenda action: handler))
+
+(define (make-agenda)
+  (make-hash-table string=?))
+
+(define (in-agenda? path agenda)
+  (hash-table-exists? agenda path))
+
+(define (update-agenda agenda path mtime)
+  (hash-table-set! agenda path mtime)
+  agenda)
+
+(define (last-modified path agenda)
+  (hash-table-ref/default agenda path #f))
+
+(define (file-modified? path last-modified)
+  (and last-modified (> (file-modification-time path) last-modified)))
+
+(define (debug-events path event)
+  (printf "New event: ~a ~a~%" event path))
+
+(define (modification-time/safe path)
+  (handle-exceptions exn #f (file-modification-time path)))
+
+(define ((notify-changed-handler event) path agenda)
+  (let ((mtime (modification-time/safe path)))
+    (cond
+     ((not (in-agenda? path agenda))
+      (event path 'change)
+      (if mtime
+	  (update-agenda agenda path mtime)
+	  agenda))
+   ((file-modified? path (last-modified path agenda))
+    (event path 'change)
+    (if mtime
+	(update-agenda agenda path mtime)
+	agenda))
+   (else agenda))))
+
+(define ((notify-all-handler event) path agenda)
+  (cond
+   ((not (in-agenda? path agenda))
+    (event path 'change)
+    (update-agenda agenda path (file-modification-time path)))
+   (else
+    (event path 'change)
+    agenda)))
+
+;; on top of this we can actually implement the protocol