Add iolib functions.
[cl-inotify.git] / inotify.lisp
index 16c3099..8c97386 100644 (file)
@@ -1,4 +1,4 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8; package: cl-inotify; -*-
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
 
 ;; Copyright (c) 2011-12, Olof-Joachim Frahm
 ;; All rights reserved.
 
 ;; Copyright (c) 2011-12, Olof-Joachim Frahm
 ;; All rights reserved.
 
 (in-package #:cl-inotify)
 
 
 (in-package #:cl-inotify)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (boundp 'in-cloexec)
+    (pushnew 'inotify1 *features*)))
+
+#+cl-inotify::inotify1
 (defbitfield (inotify1-flag :int)
   (:cloexec       #.in-cloexec)
   (:nonblock      #.in-nonblock))
 (defbitfield (inotify1-flag :int)
   (:cloexec       #.in-cloexec)
   (:nonblock      #.in-nonblock))
@@ -97,18 +102,19 @@ thus should be used only with WATCH-RAW)."
 (defsyscall inotify-init :int
   "Initialises a new inotify event queue.")
 
 (defsyscall inotify-init :int
   "Initialises a new inotify event queue.")
 
+#+cl-inotify::inotify1
 (defsyscall inotify-init1 :int
   "Initialises a new inotify event queue and passes some flags along."
   (flags inotify1-flag))
 
 (defsyscall inotify-add-watch :int
 (defsyscall inotify-init1 :int
   "Initialises a new inotify event queue and passes some flags along."
   (flags inotify1-flag))
 
 (defsyscall inotify-add-watch :int
-  "Watches a path on a event queue."
+  "Watches a path on an event queue."
   (fd :int)
   (pathname :string)
   (mask inotify-flag))
 
 (defsyscall inotify-rm-watch :int
   (fd :int)
   (pathname :string)
   (mask inotify-flag))
 
 (defsyscall inotify-rm-watch :int
-  "Removes a watched path from a event queue."
+  "Removes a watched path from an event queue."
   (fd :int)
   (wd :int))
 
   (fd :int)
   (wd :int))
 
@@ -198,8 +204,14 @@ the file descriptor is set to non-blocking I/O."
     (unwind-protect
          ;; file descriptor is collected with auto-close
          (progn
     (unwind-protect
          ;; file descriptor is collected with auto-close
          (progn
-           (setf fd (inotify-init1 (and (setf non-block nonblocking)
-                                        :nonblock)))
+           (setf non-block nonblocking)
+           #+inotify1
+           (setf fd (inotify-init1 (and non-block :nonblock)))
+           #-inotify1
+           (setf fd (inotify-init))
+           #-inotify1
+           (when non-block
+             (set-nonblocking fd T))
            (setf stream
                  ;; TODO: what about the blocking?
                  #-(or clisp sbcl)
            (setf stream
                  ;; TODO: what about the blocking?
                  #-(or clisp sbcl)
@@ -374,7 +386,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 +410,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 +429,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))))))