X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=inotify.lisp;h=0e27e6e40619240179323b6ca883286b0fe64821;hb=380091232fce38d01de465e91842a7961c709715;hp=16c309927bb5701bfa55ea7b8d7ce291934d4976;hpb=da749411569c2763b265fe56a2c128b7991efde0;p=cl-inotify.git

diff --git a/inotify.lisp b/inotify.lisp
index 16c3099..0e27e6e 100644
--- 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
-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
@@ -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."
-  `(let* ((,inotify (make-unregistered-inotify ,nonblocking)))
+  `(let ((,inotify (make-unregistered-inotify ,nonblocking)))
      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch-raw ,inotify ,@specifier))
                       rest)
+            (values)
             ,@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."
-  `(let* ((,inotify (make-inotify ,nonblocking)))
+  `(let ((,inotify (make-inotify ,nonblocking)))
      (unwind-protect
           (progn
             ,.(mapcar (lambda (specifier)
                         `(watch ,inotify ,@specifier))
                       rest)
+            (values)
             ,@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))))))