Fix example with more efficient version.

[cl-inotify.git] / inotify.lisp

diff --git a/inotify.lisp b/inotify.lisp
index 16c3099..0e27e6e 100644 (file)
--- a/inotify.lisp
+++ b/inotify.lisp
@@ -374,7 +374,9 @@ error."
 (defmacro do-events ((var inotify &key blocking-p) &body body)
   "Loops BODY with VAR bound to the next events retrieved from INOTIFY.
 The macro uses NEXT-EVENT, so reading an event won't block and the loop
 (defmacro do-events ((var inotify &key blocking-p) &body body)
   "Loops BODY with VAR bound to the next events retrieved from INOTIFY.
 The macro uses NEXT-EVENT, so reading an event won't block and the loop

-terminates if no events are available."
+terminates if no events are available.  If BLOCKING-P is set, the loop
+blocks if no events are available, otherwise it exits as soon as no
+events were encountered."

   (check-type var symbol)
   (let ((inotify-sym (gensym)))
    `(loop
   (check-type var symbol)
   (let ((inotify-sym (gensym)))
    `(loop

@@ -396,12 +398,13 @@ terminates if no events are available."
 (defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
   "Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW
 instead.  Useful if you need to monitor just a fixed set of paths."
 (defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
   "Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW
 instead.  Useful if you need to monitor just a fixed set of paths."

-  `(let* ((,inotify (make-unregistered-inotify ,nonblocking)))
+  `(let ((,inotify (make-unregistered-inotify ,nonblocking)))

      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch-raw ,inotify ,@specifier))
                       rest)
      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch-raw ,inotify ,@specifier))
                       rest)

+            (values)

             ,@body)
        (close-inotify ,inotify))))
 
             ,@body)
        (close-inotify ,inotify))))
 

@@ -414,101 +417,12 @@ more forms (PATHNAME FLAGS &KEY (REPLACE-P T)).
 
 Since the QUEUE is closed on unwinding, this macro doesn't bother with
 UNWATCH calls on all WATCHed paths."
 
 Since the QUEUE is closed on unwinding, this macro doesn't bother with
 UNWATCH calls on all WATCHed paths."

-  `(let* ((,inotify (make-inotify ,nonblocking)))
+  `(let ((,inotify (make-inotify ,nonblocking)))

      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch ,inotify ,@specifier))
                       rest)
      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch ,inotify ,@specifier))
                       rest)

+            (values)

             ,@body)
        (close-inotify ,inotify))))
             ,@body)
        (close-inotify ,inotify))))

-
-;; TODO: what about other implementations?
-#+sbcl
-(defmacro with-inotify-event-handler ((inotify
-                                       &optional (nonblocking T) (registered T)
-                                       &rest rest)
-                                      event-handler
-                                      &body body)
-  "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
-parameter whenever input happens while the BODY is executed.
-
-Other parameters are passed to WITH-(UNREGISTERED)-INOTIFY depending on the
-value of REGISTERED (default T)."
-  (let ((handle (gensym "HANDLE")))
-    `(,(if registered 'with-inotify 'with-unregistered-inotify)
-      (,inotify ,nonblocking ,@rest)
-      (sb-sys:with-fd-handler
-          ((inotify-fd ,inotify)
-           :input
-           (lambda (,handle)
-             (declare (ignore ,handle))
-             (funcall ,event-handler ,inotify)))
-          ,@body))))
-
-(defun run-inotify-program (program args rest directories flags
-                            &key function (wait T) event-handler (registered T))
-  "Runs a program and records all matched events in all DIRECTORIES using
-FLAGS.  If EVENT-HANDLER is set, it is instead called with every available
-event.
-
-PROGRAM, ARGS and REST are the arguments to SB-EXT:RUN-PROGRAM.  REST is
-passed on verbatim except for the WAIT parameter, which is set to false.
-
-PROGRAM may also be a FUNCTION, in which case it is called with
-\(ARGS . REST) as arguments and has to return a process object like from
-SB-EXT:RUN-PROGRAM.  The process also shouldn't be spawned with WAIT set.
-
-DIRECTORIES is a list of directory arguments for WATCH/-RAW.
-
-WAIT is only valid if FUNCTION is set.  If it is true, after FUNCTION has
-returned, we wait until the process has quit.
-
-On supported implementations (SBCL) the FUNCTION parameter may be used to
-do some work while the program is running and watched by the inotify queue.
-It is called with the process object and the inotify queue as arguments."
-  (let (events)
-    (labels ((run ()
-               (typecase program
-                 (function (apply program args rest))
-                 (T
-                  (apply #'sb-ext:run-program program args :wait NIL rest))))
-             (events (inotify)
-               (do-events (event inotify)
-                 (if event-handler
-                     (funcall event-handler event)
-                     (push event events))))
-             (body (inotify)
-               (unwind-protect
-                    (progn
-                      (let ((register (if registered #'watch #'watch-raw)))
-                        (mapcar (lambda (directory)
-                                  (funcall register inotify directory flags))
-                                directories))
-                      (let ((process (run)))
-                        (if function
-                            (unwind-protect
-                                 (funcall function process inotify)
-                              ;; wait in any case so catching the files will work
-                              (when wait
-                                (sb-ext:process-wait process)))
-                            (loop
-                              while (sb-ext:process-alive-p process)
-                              do (events inotify)
-                              finally (return (if event-handler
-                                                  process
-                                                  (values (nreverse events) process)))))))
-                 (close-inotify inotify))))
-      (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
-        (if function
-            #-sbcl
-            (error "the FUNCTION parameter is only supported on SBCL for now")
-            #+sbcl
-            (sb-sys:with-fd-handler
-                ((inotify-fd inotify)
-                 :input
-                 (lambda (handle)
-                   (declare (ignore handle))
-                   (events inotify)))
-                (body inotify))
-            (body inotify))))))